You can define new records in Tusk, but for now, you can only define fields (no methods or properties).

Methods and properties are on the horizon, but for now, you can work around their absence by defining a record with anonymous methods.

For example, let's suppose we wanted to make a TEmployee record like this…

type TEmployee = record private FName: string; FSalary: Double; public property Name: string read FName; property Salary: Double read FSalary; procedure GiveRaise(Value: Double); procedure Show; end;

The work-around is as follows…

type TFunc_string = reference to function: string; TFunc_Double = reference to function: Double; TProc_Double = reference to procedure(Value: Double); TEmployee = record Name: TFunc_string; Salary: TFunc_Double; GiveRaise: TProc_Double; Show: TProc; end; function NewEmployee( const Name: string; Salary: Double): TEmployee; begin Result.Name := function: string begin Result := Name; end; Result.Salary := function: Double begin Result := Salary; end; Result.GiveRaise := procedure(Value: Double) begin Salary := Salary + Value; end; Result.Show := procedure begin Writeln(Name, ': ', Salary); end; end;

With the above in place, we can work with TEmployee instances…

var Emp1 := NewEmployee('Will Williams', 1_000); var Emp2 := NewEmployee('Dave Davidson', 2_000); Emp1.Show; Emp2.Show; Writeln(Emp2.Salary); Emp2.GiveRaise(500); Emp2.Show; Writeln(Emp2.Salary);

The above prints…

Will Williams: 1000 Dave Davidson: 2000 2000 Dave Davidson: 2500 2500

We can shorten NewEmployee function using Tusk's One-Line Routines…

function NewEmployee( const Name: string; Salary: Double): TEmployee; begin Result.Name := function = Name; Result.Salary := function = Salary; Result.GiveRaise := procedure(Value: Double) = Salary := Salary + Value; Result.Show := procedure = Writeln(Name, ': ', Salary); end;

This work-around is certainly not ideal, but it does offer an effective mechanism for encapsulation.

Tusk supports both Traditional and Fluent SQL. Note that Tusk doesn't yet have anything similar to MiniCalc's pre-processing step that implicitly defines aliases to tables, parameters, and condition lists. Thus, for the time being, Tusk programs must explicitly declare variables of type VDB.TAlias, VDB.TParam, VDB.TCond, and VDB.TScope.

Here's a good example…

const Company = 'FTP'; const Profile = 'vdb:vdbEngine=ODBC;DRIVER=ODBC Driver 18 for SQL Server;' + 'ENCRYPT=Optional;PASSWORD=x;SERVER=DevEntSQLDB\Dev;' + 'TRUSTED_CONNECTION=Yes;DATABASE=Enterprise;' + 'vdbDialect=SQLServer;vdbOption:NAME=Alias;' + 'vdbOption:LINKEDREADONLY=False;vdbPoolTimeout=300'; const ReadOnlyDB = OpenDatabase(Profile); var e, t, t2, m, u: VDB.TAlias; var Reader := ReadOnlyDB.RunReader(VDB .Select(e.Col('last_name')) .Select(e.Col('first_name')) .Select(e.Col('middle_name')) .Select(e.Col('name_suffix')) .Select(e.Col('dept_name')) .Select(e.Col('dept_role')) .Select(e.Col('company_code')) .Select(e.Col('position')) .Select(u.Col('user_id')) .Select(t.Col('title_code')) .From(e.Table('hr_employee_view')) .LeftJoin(t.Table('hr_title_hist')) .On(t.Col('employee_id') = e.Col('employee_id')) .LeftJoin(m.Table('hr_employee_view')) .On(m.Col('employee_id') = e.Col('mgr_employee_id')) .LeftJoin(u.Table('app_user')) .On(u.Col('person_id') = e.Col('person_id')) .AndWhere(t.Col('effective_date') = VDB .Select(VDB.Max(t2.Col('effective_date'))) .From(t2.Table('hr_title_hist')) .Where(t2.Col('employee_id') = t.Col('employee_id')) ) .AndWhere(e.Col('company_code') = VDB.Param(Company)) .AndWhere(e.Col('employee_stat_code') = VDB.Param('A')) .OrderBy(m.Col('last_name')) .OrderBy(m.Col('first_name')) .OrderBy(e.Col('last_name')) .OrderBy(e.Col('first_name')) ); for Reader in Reader do Writeln(Reader['last_name']);

This short Tusk program implements a very simple "Slalom Skiing" game, inspired by games from long ago.

You control the skier, represented by an asterisk. Using the ← and → arrows, you try to stay within the bounds of the winding track as the game progresses.

This is what the game looks like…

The source code for this game is as follows. Note the two comments, which are hints to DSEdit.exe and Tusk.exe. The first one disables the introductory banner, and the second one skips the final "Hit ENTER..." prompt.

// Tusk:Quiet // Tusk:NoPause type TDirection = (dirNone, dirLeft, dirRight); TGameStatus = (gsRunning, gsHit, gsGameOver); TGameState = record Margin: Integer; Gap: Integer; Player: Integer; Delta: Integer; Speed: Integer; // frame time in ms FlipPct: Integer; // probability percent to flip tunnel direction Score: Integer; Lives: Integer; Status: TGameStatus; end; TGameConfig = record Dirt: Char; LeftEdge: Char; RightEdge: Char; Width: Integer; MinMargin: Integer; MarginAccel: Integer; MaxSpeed: Integer; Accel: Integer; MinFlipPct: Integer; MaxFlipPct: Integer; FlipPctDelta: Integer; FlipPeriod: Integer; end; function StartingConfig: TGameConfig; begin Result.Dirt := '='; Result.LeftEdge := '>'; Result.RightEdge := '<'; Result.Width := 80; Result.MinMargin := 5; Result.MarginAccel := 20; Result.MaxSpeed := 50; Result.Accel := 2; Result.MinFlipPct := 10; Result.MaxFlipPct := 50; Result.FlipPctDelta := 10; Result.FlipPeriod := 30 end; const Cfg = StartingConfig; // -- helpers -- function TunnelLeftEdge(const G: TGameState): Integer; begin // the number of dirt chars on the left Result := G.Gap; end; function TunnelRightEdge(const G: TGameState): Integer; begin // the number of dirt chars on the right Result := Cfg.Width - G.Gap - G.Margin*2 - 1; end; function TunnelInnerLeftPos(const G: TGameState): Integer; begin // index (0-based) of the left edge character '>' in the printed line Result := G.Gap; end; function TunnelInnerRightPos(const G: TGameState): Integer; begin // index (0-based) of the right edge character '<' in the printed line Result := G.Gap + G.Margin*2 + 1; end; // -- initialization -- procedure InitGame(var G: TGameState); begin G.Margin := 10; G.Gap := Cfg.Width div 2; G.Player := G.Gap + G.Margin; G.Delta := Random(2)*2 - 1; // either -1 or +1 G.FlipPct := 20; G.Speed := 200; G.Score := 0; G.Lives := 3; G.Status := gsRunning; end; // -- input -- function ReadGameInput(ElapsedMS: Integer; var Quit: Boolean): TDirection; var Timer: ITimer; KS: TKeystroke; begin Result := dirNone; Timer := StartNewTimer; // Poll for keystrokes until the frame time expires while Timer.ElapsedMS < ElapsedMS do begin if not KeystrokeReady(kkNonModifier) then begin Sleep(Min(ElapsedMS - Integer(Timer.ElapsedMS), 10)); Continue; end; KS := ReadKeystroke(kkNonModifier); // Windows virtual-key codes: 37 = left, 39 = right, 27 = Escape if (KS.Key = 37) and (KS.Scan = 75) then begin Result := dirLeft; Exit; end else if (KS.Key = 39) and (KS.Scan = 77) then begin Result := dirRight; Exit; end else if (KS.Key = 27) and (KS.Scan = 1) then begin Quit := True; Exit; end else begin // unexpected key: show it then pause briefly so user sees debug Writeln; Show(KS); Sleep(10*1000); end; end; end; // -- rendering -- procedure RenderLine(const G: TGameState); var leftCount, rightCount: Integer; Line: string; playerIdx: Integer; begin leftCount := TunnelLeftEdge(G); rightCount := TunnelRightEdge(G); Line := '' + StringOfChar(Cfg.Dirt, leftCount) + StringOfChar(' ', G.Margin*2 + 1) + StringOfChar(Cfg.Dirt, rightCount) + ' '; // place the visual edge markers Line[TunnelInnerLeftPos(G)+1] := Cfg.LeftEdge; Line[TunnelInnerRightPos(G)+1] := Cfg.RightEdge; // decide what to place for the player playerIdx := G.Player + 1; // convert to 1-based string index if (playerIdx >= 1) and (playerIdx <= Length(Line)) then begin if Line[playerIdx] = ' ' then Line[playerIdx] := '*' else Line[playerIdx] := 'O'; end; Write(Line); end; // -- collision -- procedure HandleCollision(var G: TGameState); begin Dec(G.Lives); G.Status := gsHit; if G.Lives <= 0 then G.Status := gsGameOver; // reset player to safe start if still alive if G.Status <> gsGameOver then G.Player := G.Gap + G.Margin; end; function IsPlayerInTunnel(const G: TGameState): Boolean; var // inclusive positions of tunnel interior (0-based) leftPos, rightPos: Integer; begin // interior space starts after '>' leftPos := TunnelInnerLeftPos(G)+1; // interior space ends before '<' rightPos := TunnelInnerRightPos(G)-1; Result := (G.Player >= leftPos) and (G.Player <= rightPos); end; // -- tunnel update -- procedure UpdateTunnel(var G: TGameState); begin // bounce at edges if G.Gap <= 0 then begin G.Gap := 1; G.Delta := +1; end else if G.Gap >= Cfg.Width - G.Margin*2 - 2 then begin G.Gap := Cfg.Width - G.Margin*2 - 3; G.Delta := -1; end else begin // random flip based on percentage if Random(100) < G.FlipPct then G.Delta := -G.Delta; Inc(G.Gap, G.Delta); end; end; // -- difficulty -- procedure UpdateDifficulty(var G: TGameState); begin // Margin reduction first, then speed improvements if G.Margin > Cfg.MinMargin then begin if G.Score mod Cfg.MarginAccel = 0 then Dec(G.Margin); end else begin if (Cfg.Accel > 0) and (G.Score mod Cfg.Accel = 0) then begin if G.Speed > Cfg.MaxSpeed then Dec(G.Speed); end; end; // Flip percentage oscillation if (Cfg.FlipPeriod > 0) and (G.Score mod Cfg.FlipPeriod = 0) then begin if G.FlipPct = Cfg.MinFlipPct then Inc(G.FlipPct, Cfg.FlipPctDelta) else if G.FlipPct = Cfg.MaxFlipPct then Dec(G.FlipPct, Cfg.FlipPctDelta) else if Random(2) = 0 then Inc(G.FlipPct, Cfg.FlipPctDelta) else Dec(G.FlipPct, Cfg.FlipPctDelta); end; end; // -- single frame execution -- procedure RunFrame(var G: TGameState; var Quit: Boolean); var dir: TDirection; begin // Advance tunnel geometry UpdateTunnel(G); // Prepare and render the line RenderLine(G); // Check collision purely in logical space before reading input if not IsPlayerInTunnel(G) then begin // show collision visually as 'O' // (render already placed O if collision) HandleCollision(G); if G.Status = gsGameOver then begin Quit := True; Exit; end; end; // Wait for input within the frame time dir := ReadGameInput(G.Speed, Quit); if Quit then Exit; // Apply player movement case:strict dir of dirLeft: if G.Player > 0 then Dec(G.Player); dirRight: if G.Player < Cfg.Width - 1 then Inc(G.Player); dirNone: (* nothing *); end; // Score and difficulty Inc(G.Score); UpdateDifficulty(G); // If hit state was set, return to running if G.Status = gsHit then G.Status := gsRunning; // Write score on its own line (keeps output moving) Writeln(G.Score); end; // -- top-level runner -- procedure RunGame; var G: TGameState; Quit: Boolean; begin InitGame(G); Quit := False; while not Quit do begin RunFrame(G, Quit); if (G.Status = gsGameOver) or Quit then Break; end; Writeln; Writeln('Game Over. Score: ', G.Score); end; // -- entry point -- procedure Main; begin RunGame; end; Main; Readln;

To run this program, copy the above code into a new tab in DSEdit, set the highlighter to "Tusk", and hit F9.

You have three "lives", but be warned – the game speeds up as time passes!

Hit Esc to quit immediately.

Here is a direct link the file…

• Demo2.tusk
  

This example program is an evolution of the previous one. This version uses Windows Console API functions to draw characters at specific locations. This allows the skier to appear a few lines above the bottom of the screen, and eliminates the trail of skiers left behind as you go – significant improvements.

Here's what the program looks like in action…

  

The source code for this game is as follows. Note the two comments, which are hints to DSEdit.exe and Tusk.exe. The first one disables the introductory banner, and the second one skips the final "Hit ENTER..." prompt.

// Tusk:Quiet // Tusk:NoPause {$Include Console.tusk} type TDirection = (dirNone, dirLeft, dirRight); TGameStatus = (gsRunning, gsHit, gsGameOver); TTunnelState = record Gap: Integer; Margin: Integer; end; TGameState = record Margin: Integer; Gap: Integer; Player: Integer; Delta: Integer; Speed: Integer; // frame time in ms FlipPct: Integer; // probability percent to flip tunnel direction Score: Integer; Lives: Integer; Status: TGameStatus; ScreenWidth: Integer; ScreenHeight: Integer; PlayfieldHeight: Integer; // circular buffer for tunnel history TunnelBuffer: TArray<TTunnelState>; BufferHead: Integer; // next position to write end; TGameConfig = record Dirt: Char; LeftEdge: Char; RightEdge: Char; Width: Integer; MinMargin: Integer; MarginAccel: Integer; MaxSpeed: Integer; Accel: Integer; MinFlipPct: Integer; MaxFlipPct: Integer; FlipPctDelta: Integer; FlipPeriod: Integer; PlayerRowOffset: Integer; // how many rows above bottom to show player end; function StartingConfig: TGameConfig; begin Result.Dirt := #$2592; // Medium Shade Result.LeftEdge := #$2591; // Light Shade Result.RightEdge := #$2591; // Light Shade Result.Width := 80; Result.MinMargin := 5; Result.MarginAccel := 20; Result.MaxSpeed := 50; Result.Accel := 2; Result.MinFlipPct := 10; Result.MaxFlipPct := 50; Result.FlipPctDelta := 10; Result.FlipPeriod := 30; Result.PlayerRowOffset := 4; // player is 4 rows above bottom end; const Cfg = StartingConfig; // -- helpers -- function TunnelLeftEdge( Gap, Margin: Integer): Integer; begin Result := Gap; end; function TunnelRightEdge( Gap, Margin: Integer): Integer; begin Result := Cfg.Width - Gap - Margin*2 - 1; end; function TunnelInnerLeftPos( Gap: Integer): Integer; begin Result := Gap; end; function TunnelInnerRightPos( Gap, Margin: Integer): Integer; begin Result := Gap + Margin*2 + 1; end; // -- buffer management -- procedure AddTunnelToBuffer( var G: TGameState; Gap, Margin: Integer); begin G.TunnelBuffer[G.BufferHead].Gap := Gap; G.TunnelBuffer[G.BufferHead].Margin := Margin; G.BufferHead := (G.BufferHead + 1) mod Length(G.TunnelBuffer); end; function GetTunnelFromBuffer( const G: TGameState; RowsBack: Integer): TTunnelState; var idx: Integer; begin // RowsBack = 0 is the most recent (last added) // RowsBack = 1 is one before that, etc. idx := (G.BufferHead - 1 - RowsBack + Length(G.TunnelBuffer)) mod Length(G.TunnelBuffer); Result := G.TunnelBuffer[idx]; end; // -- initialization -- procedure InitGame( var G: TGameState); var i: Integer; begin Console.GetConsoleSize(G.ScreenWidth, G.ScreenHeight); G.PlayfieldHeight := G.ScreenHeight - 2; // leave room for score line SetLength(G.TunnelBuffer, 100); // Maybe PlayfieldHeight instead? G.Margin := 10; G.Gap := Cfg.Width div 2; G.Player := G.Gap + G.Margin; G.Delta := Random(2)*2 - 1; G.FlipPct := 20; G.Speed := 200; G.Score := 0; G.Lives := 3; G.Status := gsRunning; G.BufferHead := 0; // Initialize buffer with starting tunnel position for i := 0 to High(G.TunnelBuffer) do begin G.TunnelBuffer[i].Gap := G.Gap; G.TunnelBuffer[i].Margin := G.Margin; end; Console.ClearScreen; end; // -- input -- function ReadGameInput( var RemainMS: Integer; var Direction: TDirection): Boolean; var Timer: ITimer; KS: TKeystroke; begin Timer := StartNewTimer; while Timer.ElapsedMS < RemainMS do begin if not KeystrokeReady(kkNonModifier) then begin Sleep(Min(RemainMS - Integer(Timer.ElapsedMS), 10)); Continue; end; KS := ReadKeystroke(kkNonModifier); if (KS.Key = 37) and (KS.Scan = 75) then begin Direction := dirLeft; Dec(RemainMS, Timer.ElapsedMS); Exit(True); end else if (KS.Key = 39) and (KS.Scan = 77) then begin Direction := dirRight; Dec(RemainMS, Timer.ElapsedMS); Exit(True); end else if (KS.Key = 27) and (KS.Scan = 1) then begin Exit(False); end; end; RemainMS := 0; Direction := dirNone; Result := True; end; // -- rendering -- procedure RenderTunnelLine( Y: Integer; Gap, Margin: Integer; PlayerX: Integer; ShowPlayer: Boolean); var leftCount, rightCount: Integer; leftPos, rightPos: Integer; playerChar: Char; begin leftCount := TunnelLeftEdge(Gap, Margin); rightCount := TunnelRightEdge(Gap, Margin); leftPos := TunnelInnerLeftPos(Gap); rightPos := TunnelInnerRightPos(Gap, Margin); // Draw left dirt if leftCount > 0 then Console.WriteCharsAt(0, Y, Cfg.Dirt, leftCount); // Draw tunnel interior (spaces) Console.WriteCharsAt(leftPos + 1, Y, ' ', Margin*2); // Draw right dirt if rightCount > 0 then Console.WriteCharsAt(rightPos + 1, Y, Cfg.Dirt, rightCount); // Draw edge markers Console.WriteCharAt(leftPos, Y, Cfg.LeftEdge); Console.WriteCharAt(rightPos, Y, Cfg.RightEdge); // Draw player if on this line if ShowPlayer then begin if (PlayerX >= leftPos + 1) and (PlayerX <= rightPos - 1) then playerChar := #9731 // Snowman else playerChar := 'O'; // collision Console.WriteCharAt(PlayerX, Y, playerChar); end; end; procedure RenderPlayfield( var G: TGameState); var y, rowsBack: Integer; tunnelData: TTunnelState; playerY: Integer; begin playerY := G.PlayfieldHeight - Cfg.PlayerRowOffset; // Render from top to bottom // Top rows show "future" tunnel positions for y := 0 to G.PlayfieldHeight - 1 do begin rowsBack := G.PlayfieldHeight - 1 - y; tunnelData := GetTunnelFromBuffer(G, rowsBack); RenderTunnelLine( y, tunnelData.Gap, tunnelData.Margin, G.Player, y = playerY); end; // Render score and status line Console.WriteStringAt( 0, G.PlayfieldHeight + 1, DSFormat('Score: %d Lives: %d Speed: %d Margin: %d ', [G.Score, G.Lives, G.Speed, G.Margin])); end; // -- collision -- procedure HandleCollision( var G: TGameState); begin Dec(G.Lives); G.Status := gsHit; if G.Lives <= 0 then G.Status := gsGameOver; if G.Status <> gsGameOver then G.Player := G.Gap + G.Margin; end; function IsPlayerInTunnel( PlayerX, Gap, Margin: Integer): Boolean; var leftPos, rightPos: Integer; begin leftPos := TunnelInnerLeftPos(Gap) + 1; rightPos := TunnelInnerRightPos(Gap, Margin) - 1; Result := (PlayerX >= leftPos) and (PlayerX <= rightPos); end; // -- tunnel update -- procedure UpdateTunnel( var G: TGameState); begin if G.Gap <= 0 then begin G.Gap := 1; G.Delta := +1; end else if G.Gap >= Cfg.Width - G.Margin*2 - 2 then begin G.Gap := Cfg.Width - G.Margin*2 - 3; G.Delta := -1; end else begin if Random(100) < G.FlipPct then G.Delta := -G.Delta; Inc(G.Gap, G.Delta); end; // Add new tunnel position to buffer AddTunnelToBuffer(G, G.Gap, G.Margin); end; // -- difficulty -- procedure UpdateDifficulty( var G: TGameState); begin if G.Margin > Cfg.MinMargin then begin if G.Score mod Cfg.MarginAccel = 0 then Dec(G.Margin); end else begin if (Cfg.Accel > 0) and (G.Score mod Cfg.Accel = 0) then begin if G.Speed > Cfg.MaxSpeed then Dec(G.Speed); end; end; if (Cfg.FlipPeriod > 0) and (G.Score mod Cfg.FlipPeriod = 0) then begin if G.FlipPct = Cfg.MinFlipPct then Inc(G.FlipPct, Cfg.FlipPctDelta) else if G.FlipPct = Cfg.MaxFlipPct then Dec(G.FlipPct, Cfg.FlipPctDelta) else if Random(2) = 0 then Inc(G.FlipPct, Cfg.FlipPctDelta) else Dec(G.FlipPct, Cfg.FlipPctDelta); end; end; // -- single frame execution -- function RunFrame( var G: TGameState): Boolean; var dir: TDirection; playerTunnel: TTunnelState; DurationMS: Integer; begin // Advance tunnel geometry (adds to buffer) UpdateTunnel(G); DurationMS := G.Speed; repeat // Render entire playfield RenderPlayfield(G); // Check collision at player's current row playerTunnel := GetTunnelFromBuffer(G, Cfg.PlayerRowOffset); if not IsPlayerInTunnel( G.Player, playerTunnel.Gap, playerTunnel.Margin) then begin HandleCollision(G); if G.Status = gsGameOver then Exit(False); end; // Wait for input if not ReadGameInput(DurationMS, dir) then Exit(False); // Apply player movement case:strict dir of dirLeft: if G.Player > 0 then Dec(G.Player); dirRight: if G.Player < Cfg.Width - 1 then Inc(G.Player); dirNone: (* nothing *); end; until dir = dirNone; // Score and difficulty Inc(G.Score); UpdateDifficulty(G); if G.Status = gsHit then G.Status := gsRunning; Result := True; end; // -- top-level runner -- procedure RunGame; var G: TGameState; begin InitGame(G); while RunFrame(G) do begin // nothing end; Console.WriteStringAt(0, G.PlayfieldHeight + 2, ''); Writeln; Writeln('Game Over. Final Score: ', G.Score); end; // -- entry point -- procedure Main; begin RunGame; end; Main; Readln;

Note that this program starts by including Console.tusk; this file can be found in the following section.

To run this program, copy the above code into a new tab in DSEdit, set the highlighter to "Tusk", and hit F9.

You have three "lives", but be warned – the game speeds up as time passes!

Hit Esc to quit immediately.

Here are direct links to all relevant files…

• Console.tusk
  
• Demo4.tusk
  

The previous program uses an included file named Console.tusk. This file exposes some of the Windows Console API functions in an object-oriented fashion…

const CON_BLACK = 0; CON_BLUE = 1; CON_GREEN = 2; CON_CYAN = 3; CON_RED = 4; CON_MAGENTA = 5; CON_BROWN = 6; CON_LIGHT_GRAY = 7; CON_DARK_GRAY = 8; CON_LIGHT_BLUE = 9; CON_LIGHT_GREEN = 10; CON_LIGHT_CYAN = 11; CON_LIGHT_RED = 12; CON_LIGHT_MAGENTA = 13; CON_YELLOW = 14; CON_WHITE = 15; type TClearScreen = reference to procedure; TGetConsoleSize = reference to procedure( out Width, Height: Integer); TWriteStringAt = reference to procedure( X, Y: Integer; const s: string); TWriteTextAt = reference to procedure( X, Y: Integer; const Text: TArray<Char>); TWriteCharAt = reference to procedure( X, Y: Integer; Ch: Char); TWriteCharsAt = reference to procedure( X, Y: Integer; Ch: Char; Count: Integer); TReadCharAt = reference to function( X, Y: Integer): Char; TSetTextAttr = reference to procedure( Attr: Word); TWriteAttrsAt = reference to procedure( X, Y: Integer; const Attrs: TArray<Word>); TConsole = record ClearScreen: TClearScreen; GetConsoleSize: TGetConsoleSize; WriteStringAt: TWriteStringAt; WriteTextAt: TWriteTextAt; WriteCharAt: TWriteCharAt; WriteCharsAt: TWriteCharsAt; ReadCharAt: TReadCharAt; SetTextAttr: TSetTextAttr; WriteAttrsAt: TWriteAttrsAt; end; function NewConsole(ConsoleHandle: THandle): TConsole; procedure ClearScreen(ConsoleHandle: THandle); var ConsoleInfo: TConsoleScreenBufferInfo; CharsWritten: DWORD; ConSize: DWORD; Origin: TCoord; begin GetConsoleScreenBufferInfo(ConsoleHandle, ConsoleInfo); ConSize := ConsoleInfo.dwSize.X * ConsoleInfo.dwSize.Y; Origin.X := 0; Origin.Y := 0; FillConsoleOutputCharacter( ConsoleHandle, ' ', ConSize, Origin, CharsWritten); FillConsoleOutputAttribute( ConsoleHandle, ConsoleInfo.wAttributes, ConSize, Origin, CharsWritten); SetConsoleCursorPosition( ConsoleHandle, Origin); end; procedure GetConsoleSize( ConsoleHandle: THandle; out Width, Height: Integer); var ConsoleInfo: TConsoleScreenBufferInfo; begin GetConsoleScreenBufferInfo(ConsoleHandle, ConsoleInfo); Width := ConsoleInfo.srWindow.Right - ConsoleInfo.srWindow.Left + 1; Height := ConsoleInfo.srWindow.Bottom - ConsoleInfo.srWindow.Top + 1; end; procedure WriteStringAt( ConsoleHandle: THandle; X, Y: Integer; const s: string); var Position: TCoord; CharsWritten: DWORD; begin Position.X := X; Position.Y := Y; WriteConsoleOutputCharacter( ConsoleHandle, PChar(s), Length(s), Position, CharsWritten); end; procedure WriteTextAt( ConsoleHandle: THandle; X, Y: Integer; const Text: TArray<Char>); var Position: TCoord; CharsWritten: DWORD; begin Position.X := X; Position.Y := Y; WriteConsoleOutputCharacter( ConsoleHandle, PChar(Text), Length(Text), Position, CharsWritten); end; procedure WriteCharAt( ConsoleHandle: THandle; X, Y: Integer; Ch: Char); var Position: TCoord; CharsWritten: DWORD; begin Position.X := X; Position.Y := Y; WriteConsoleOutputCharacter( ConsoleHandle, @Ch, 1, Position, CharsWritten); end; procedure WriteCharsAt( ConsoleHandle: THandle; X, Y: Integer; Ch: Char; Count: Integer); var Position: TCoord; CharsWritten: DWORD; begin Position.X := X; Position.Y := Y; FillConsoleOutputCharacter( ConsoleHandle, Ch, Count, Position, CharsWritten); end; function ReadCharAt( ConsoleHandle: THandle; X, Y: Integer): Char; var Position: TCoord; CharsRead: DWORD; begin Position.X := X; Position.Y := Y; ReadConsoleOutputCharacter( ConsoleHandle, @Result, 1, Position, CharsRead); end; procedure WriteAttrsAt( ConsoleHandle: THandle; X, Y: Integer; const Attrs: TArray<Word>); var Position: TCoord; AttrsWritten: DWORD; begin Position.X := X; Position.Y := Y; WriteConsoleOutputAttribute( ConsoleHandle, Pointer(Attrs), Length(Attrs), Position, AttrsWritten); end; begin Result.ClearScreen := procedure = ClearScreen(ConsoleHandle); Result.GetConsoleSize := procedure(out Width, Height: Integer) = GetConsoleSize(ConsoleHandle, Width, Height); Result.WriteStringAt := procedure(X, Y: Integer; const s: string) = WriteStringAt(ConsoleHandle, X, Y, s); Result.WriteTextAt := procedure(X, Y: Integer; const Text: TArray<Char>) = WriteTextAt(ConsoleHandle, X, Y, Text); Result.WriteCharAt := procedure(X, Y: Integer; Ch: Char) = WriteCharAt(ConsoleHandle, X, Y, Ch); Result.WriteCharsAt := procedure(X, Y: Integer; Ch: Char; Count: Integer) = WriteCharsAt(ConsoleHandle, X, Y, Ch, Count); Result.ReadCharAt := function(X, Y: Integer) = ReadCharAt(ConsoleHandle, X, Y); Result.SetTextAttr := procedure(Attr: Word) = SetConsoleTextAttribute( ConsoleHandle, Attr); Result.WriteAttrsAt := procedure(X, Y: Integer; const Attrs: TArray<Word>) = WriteAttrsAt(ConsoleHandle, X, Y, Attrs); end; const Console = NewConsole(GetStdHandle(STD_OUTPUT_HANDLE));

The overall purpose of this file is to define Console, a record with methods like ClearScreen and WriteStringAt. This allows us to do things like…

Console.WriteStringAt(5, 5, 'Hello');

Instead of this…

var Text := 'Hello'; var Position: TCoord; Position.X := X; Position.Y := Y; var CharsWritten: DWORD; WriteConsoleOutputCharacter( GetStdHandle(STD_OUTPUT_HANDLE), PChar(Text), Length(Text), Position, CharsWritten); end;

To use this file in example programs from this article, create a Console.tusk file with the above contents, or simply paste this file directly in the example program (replacing the Include directive).

This program is a simple game inspired by Pac-Man…

  

You control the yellow @ sign with the arrow keys. The ghosts are the red asterisks, but they turn into circles when they are vulnerable.

This program also uses Console.tusk, discussed above.

In addition, the maze itself resides in a separate file, named TuskMaze.tusk…

  

The source code for the game itself is as follows…

// Tusk:Quiet // Tusk:NoPause {$Include Console.tusk} {$Include TuskMaze.tusk} const UNI_POWER = #9679; // Power pill UNI_DOT = #183; // Regular dot UNI_TUSK = '@'; // TuskMan UNI_GHOST = '*'; // Ghost UNI_SCARED = 'o'; // Scared ghost GhostCount = 4; // Number of ghosts MS_PER_FRAME = 125; // Duration of each frame POINTS_DOT = 5; // Points awarded for normal dot POINTS_POWER = 25; // Points awarded for power pill POINTS_GHOST = 200; // Points awarded for eating a ghost // Number of frames that Power Pill Invulnerability lasts POWER_FRAMES = 100; // Percent chance a ghost doesn't move in a given frame PCT_GHOST_NO_MOVE = 10; // Percent chance ghost 0 does a 180 PCT_GHOST_0_UTURN = 5; // Percent chance ghost 1 takes a turn PCT_GHOST_1_TURN = 45; // Percent chance ghost 2/3 takes a turn PCT_GHOST_23_TURN = 25; vkLeft = $25; vkUp = $26; vkRight = $27; vkDown = $28; vkEscape = $1B; VK_LEFT = vkLeft; VK_UP = vkUp; VK_RIGHT = vkRight; VK_DOWN = vkDown; VK_ESCAPE = vkEscape; type TCell = ( cSolid, // Impassible space cEmpty, // Empty space cDot, // Dots are yummy cPower, // Power pill cPlayer, // TuskMan himself cGhost0, // Inky cGhost1, // Bliny cGhost2, // Pinky cGhost3, // Clyde ); PCell = ^TCell; TGhost = record Location: TPoint; Velocity: TPoint; end; TBoard = record Width, Height: Integer; Map: TArray<TArray<TCell>>; // [Height, Width] Ghosts: TArray<TGhost>; // [GhostCount] Player: TPoint; Velocity: TPoint; // Player's movement Text: IStringList; GameOver: Boolean; Score: Integer; Power: Integer; end; procedure LoadBoard( var Board: TBoard; const Text: string); var ls: IStringList; x, y, i: Integer; Line: string; Src: PChar; Dst: PCell; p: TPoint; begin SetLength(Board.Ghosts, GhostCount); Board.Ghosts[0].Velocity := Point(0, +1); Board.Ghosts[1].Velocity := Point(-2, 0); Board.Ghosts[2].Velocity := Point(0, -1); Board.Ghosts[3].Velocity := Point(+2, 0); ls := NewStringList(Text); Board.Text := ls; Board.Height := ls.Count; Board.Width := Length(ls[0]); for y := 1 to ls.Count-1 do begin if Length(ls[y]) <> Board.Width then DSRaise('Non-rectangular board'); end; SetLength(Board.Map, Board.Height); for y := 0 to Board.Height-1 do begin SetLength(Board.Map[y], Board.Width); Line := ls[y]; Src := PChar(Pointer(Line)); Dst := PCell(Board.Map[y]); for x := 0 to Board.Width-1 do begin case Src^ of UNI_POWER: Dst^ := cPower; UNI_DOT: Dst^ := cDot; ' ': Dst^ := cEmpty; '0': Dst^ := cGhost0; '1': Dst^ := cGhost1; '2': Dst^ := cGhost2; '3': Dst^ := cGhost3; 'C': Dst^ := cPlayer; else Dst^ := cSolid; end; if Dst^ in [cPlayer..cGhost3] then begin i := -1; p := Point(x, y); case Dst^ of cGhost0: i := 0; cGhost1: i := 1; cGhost2: i := 2; cGhost3: i := 3; cPlayer: Board.Player := p; end; if i >= 0 then Board.Ghosts[i].Location := p; if Dst^ = cPlayer then begin Dst^ := cEmpty; Src^ := ' '; end else begin Dst^ := cDot; Src^ := UNI_DOT; end; end; Inc(Src); Inc(Dst); end; end; end; procedure RenderFrame(const Board: TBoard); var x, y, i: Integer; Line: string; Dst: PChar; Src: PCell; Attr: PWord; p: TPoint; Attrs: TArray<Word>; begin SetLength(Attrs, Board.Width); for y := 0 to Board.Height-1 do begin Line := Copy(Board.Text[y]); Dst := PChar(Pointer(Line)); Src := PCell(Board.Map[y]); Attr := PWord(Attrs); for x := 0 to Board.Width-1 do begin if Src^ <> cSolid then begin if Src^ = cEmpty then Dst^ := ' '; p := Point(x, y); if Board.Player = p then Dst^ := UNI_TUSK else begin for i := 0 to GhostCount-1 do if Board.Ghosts[i].Location = p then begin Dst^ := if Board.Power > 0 then UNI_SCARED else UNI_GHOST; Break; end; end; end; case Dst^ of UNI_GHOST: Attr^ := CON_LIGHT_RED; UNI_SCARED: if Board.Power < 5 then Attr^ := CON_YELLOW else if Board.Power < 15 then Attr^ := CON_LIGHT_RED else Attr^ := CON_LIGHT_MAGENTA; UNI_TUSK: Attr^ := CON_YELLOW; UNI_POWER: Attr^ := CON_LIGHT_GREEN; UNI_DOT: Attr^ := CON_WHITE; ' ': Attr^ := CON_BLACK; 'T', 'U', 'S', 'K': Attr^ := CON_LIGHT_BLUE; Unicode.LozengeHollow: Attr^ := CON_MAGENTA; else Attr^ := CON_LIGHT_CYAN; end; Inc(Src); Inc(Dst); Inc(Attr); end; Console.WriteStringAt(0, y, Line); Console.WriteAttrsAt(0, y, Attrs); end; Line := DSFormat('%i', [Board.Score]); if Board.Power > 0 then Line := DSFormat('%s - POWER: %i', [Line, Board.Power]); Line := ' ' + Line + ' '; Console.WriteStringAt( (Board.Width - Length(Line)) div 2, Board.Height, Line); end; function MovePlayer(var Board: TBoard; Vel: TPoint): Boolean; var p: TPoint; c: PCell; i: Integer; begin p := Board.Player + Vel; if p.x < 0 then p.x := Board.Width-1 else if p.x >= Board.Width then p.x := 0; c := @Board.Map[p.y][p.x]; if c^ = cSolid then Exit(False); Result := True; Board.Player := p; Board.Velocity := Vel; for i := 0 to GhostCount-1 do if p = Board.Ghosts[i].Location then begin if Board.Power = 0 then begin Board.GameOver := True; Exit; end; Board.Ghosts[i].Location := TPoint.Zero; Inc(Board.Score, POINTS_GHOST); end; case c^ of cDot: begin c^ := cEmpty; Inc(Board.Score, POINTS_DOT); end; cPower: begin c^ := cEmpty; Inc(Board.Score, POINTS_POWER); Inc(Board.Power, POWER_FRAMES); end; end; end; function RandomDirection: TPoint; begin case Random(4) of 0: Result := Point(0, +1); 1: Result := Point(0, -1); 2: Result := Point(+2, 0); 3: Result := Point(-2, 0); else InternalError; end; end; procedure MoveGhost( var Board: TBoard; var Ghost: TGhost; Index: Integer); var Pct: Integer; p: TPoint; begin if Ghost.Location = TPoint.Zero then Exit; if Random(100) < PCT_GHOST_NO_MOVE then Exit; if Index = 0 then begin if Random(100) < PCT_GHOST_0_UTURN then begin Ghost.Velocity.x := -Ghost.Velocity.x; Ghost.Velocity.y := -Ghost.Velocity.y; end; end else begin Pct := if Index = 1 then PCT_GHOST_1_TURN else PCT_GHOST_23_TURN; if Random(100) < Pct then begin var v: TPoint; if Ghost.Velocity.x = 0 then v := Point(Random(2)*4 - 2, 0) else v := Point(0, Random(2)*2 - 1); p := Ghost.Location + v; if p.x < 0 then p.x := Board.Width-1 else if p.x >= Board.Width then p.x := 0; if Board.Map[p.y][p.x] <> cSolid then Ghost.Velocity := v; end; end; p := Ghost.Location + Ghost.Velocity; if p.x < 0 then p.x := Board.Width-1 else if p.x >= Board.Width then p.x := 0; if p = Board.Player then begin if Board.Power = 0 then Board.GameOver := True else begin Inc(Board.Score, POINTS_GHOST); Ghost.Location := TPoint.Zero; end; Exit; end; while Board.Map[p.y][p.x] = cSolid do begin Ghost.Velocity := RandomDirection; p := Ghost.Location + Ghost.Velocity; end; Ghost.Location := p; end; procedure UpdateGame(var Board: TBoard; const Vel: TPoint); var i: Integer; PlayerMoved: Boolean; begin for i := 0 to GhostCount-1 do MoveGhost(Board, Board.Ghosts[i], i); if Board.GameOver then Exit; PlayerMoved := False; if Vel <> TPoint.Zero then if MovePlayer(Board, Vel) then PlayerMoved := True; if not PlayerMoved then if Board.Velocity <> TPoint.Zero then MovePlayer(Board, Board.Velocity); if Board.Power > 0 then Dec(Board.Power); end; procedure GameLoop(var Board: TBoard); var keystroke: TKeystroke; p: TPoint; t: ITimer; Elapsed, Remain: Integer; begin t := NewTimer; while not Board.GameOver do begin t.Restart; Console.WriteStringAt(Board.Width + 1, 0, IntToStr(Elapsed)); while KeystrokeReady(kkNonModifier, False) do begin keystroke := ReadKeystroke(kkNonModifier, False); case keystroke.Key of VK_UP: p := Point(0, -1); VK_DOWN: p := Point(0, +1); VK_LEFT: p := Point(-2, 0); VK_RIGHT: p := Point(+2, 0); VK_ESCAPE: Exit; end; end; UpdateGame(Board, p); RenderFrame(Board); Elapsed := t.ElapsedMS; Remain := MS_PER_FRAME - Elapsed; if Remain > 0 then Sleep(Remain); end; Write('Hit ENTER...'); Readln; end; procedure Main; var Board: TBoard; begin LoadBoard(Board, MazeText); Console.SetTextAttr(CON_WHITE); Console.ClearScreen; for var i := 1 to Board.Height do Writeln; GameLoop(Board); end; Main;

Here are direct links to all relevant files…

• Console.tusk
  
• TuskMaze.tusk
  
• TuskMan.tusk