Compare commits

..

No commits in common. "main" and "fb-accel" have entirely different histories.

19 changed files with 62 additions and 296 deletions

View file

@ -111,7 +111,7 @@ If heap allocation fails, *new* does not return and instead causes a runtime err
variable to *niL* if heap allocation fails. variable to *niL* if heap allocation fails.
The function *MemAvail* returns the number of free bytes on the heap. It does not guarantee that this amount of memory can be allocated with *new*, because heap space can be fragmented. The function *MemAvail* returns the number of free bytes on the heap. It does not guarantee that this amount of memory can be allocated with *new*, because heap space can be fragmented.
The function *MaxAvail* returns the size of the largest contiguous block of available heap memory in bytes. The function *MaxAvail*, which exists in some versions of Turbo Pascal and returns the size of the largest contiguous block of available heap memory, is not (yet) implemented.
## I/O ## I/O
I/O handling in Tridora Pascal is mostly compatible with other Pascal dialects when reading/writing simple variables from/to the console. There are big differences when opening/reading/writing files explicitly. I/O handling in Tridora Pascal is mostly compatible with other Pascal dialects when reading/writing simple variables from/to the console. There are big differences when opening/reading/writing files explicitly.
@ -236,7 +236,7 @@ In Wirth Pascal, labels must be numbers. Other Pascal dialects also allow normal
Tridora-Pascal only allows identifiers as labels. Tridora-Pascal only allows identifiers as labels.
## Units ## Units
Units are the method to create libraries in Tridora-Pascal, that is, code modules that can Units are the method to create libraries in Tridora-Pascal, that is, codes module that can
be reused in other programs. be reused in other programs.
Tridora-Pascal follows the unit syntax that has been established in UCSD-Pascal and is also Tridora-Pascal follows the unit syntax that has been established in UCSD-Pascal and is also
@ -275,7 +275,7 @@ in the *SYSTEM* volume.
A unit implementation file should start with a *UNIT* statement instead of a *PROGRAM* A unit implementation file should start with a *UNIT* statement instead of a *PROGRAM*
statement. statement.
It should only be compiled, not assembled. It should be compiled, not assembled.
When building a program that uses units, the assembler will include an assembly language When building a program that uses units, the assembler will include an assembly language
file for each unit. file for each unit.

View file

@ -9,11 +9,11 @@ Registers
| _FB_PS_ | $90C | Palette Select | | _FB_PS_ | $90C | Palette Select |
| _FB_PD_ | $910 | Palette Data | | _FB_PD_ | $910 | Palette Data |
| _FB_CTL_ | $914 | Control Register | | _FB_CTL_ | $914 | Control Register |
| _FB_SHIFTER_ | $918 | Shift Assist Register | | _FB_SHIFTER | $918 | Shift Assist Register |
| _FB_SHIFTCOUNT_ | $91C | Shift Count Register | | _FB_SHIFTCOUNT | $91C | Shift Count Register |
| _FB_SHIFTERM_ | $920 | Shifted Mask Register | | _FB_SHIFTERM | $920 | Shifted Mask Register |
| _FB_SHIFTERSP_ | $924 | Shifter Spill Register | | _FB_SHIFTERSP | $924 | Shifter Spill Register |
| _FB_MASKGEN_ | $928 | Mask Generator Register | | _FB_MASKGEN | $928 | Mask Generator Register |
## Pixel Data ## Pixel Data
Pixel data is organized in 32-bit-words. With four bits per pixel, one word Pixel data is organized in 32-bit-words. With four bits per pixel, one word
@ -121,12 +121,12 @@ For each four bits of a pixel, the corresponding four mask bits
are all set to one if the pixel value is not zero. are all set to one if the pixel value is not zero.
This can be used to combine foreground and background pixel data This can be used to combine foreground and background pixel data
where a pixel value of zero is used to indicate a transparent foreground pixel. with a pixel value of zero for a transparent background color.
Usually, the mask will be inverted with a *NOT* instruction. Usually, the mask will be inverted with a *NOT* instruction
The result can then be used to clear all pixels in the background to clear all pixels in the background that are set in the foreground
that are set in the foreground, using an *AND* instruction. with an *AND* instruction
As the last step, foreground and masked background data can be combined with an *OR* instruction. before *ORing* foreground and background together.
Example in hexadecimal, each digit is a pixel: Example in hexadecimal, each digit is a pixel:
| Pixel Data | Mask | | Pixel Data | Mask |

View file

@ -1,55 +1,34 @@
program animate; program animate;
uses sprites,pcmaudio; uses sprites;
type PictData = record type PictData = record
magic,mode:integer; magic,mode:integer;
palette: array [0..15] of integer; palette: array [0..15] of integer;
pixeldata: array [0..31999] of integer; pixeldata: array [0..31999] of integer;
end; end;
Sprite = record Sprite = record
x,y:integer; x,y:integer;
oldX,oldY:integer;
xdelta,ydelta:integer; xdelta,ydelta:integer;
curFrame:integer; curFrame:integer;
frameCount:integer; frameCount:integer;
frameTime:integer; frameTime:integer;
frameLeft:integer; frameLeft:integer;
moveTime:integer;
moveLeft:integer;
changed:boolean; changed:boolean;
frame:array [0..3] of SpritePixels; frame:array [0..3] of SpritePixels;
end; end;
var pic:PictData; var pic:PictData;
filename:string;
infile:file; infile:file;
ch:char; ch:char;
stickMan:Sprite; stickMan:Sprite;
rocket:Sprite; rocket:Sprite;
rocket2:Sprite;
rocket3:Sprite;
buf:SndBufPtr;
procedure WaitVSync; external; procedure WaitVSync; external;
function readAudioFile(fname:string):SndBufPtr; procedure loadPalette(var pic:PictData);
var size:integer;
buf:SndBufPtr;
f:file;
begin
open(f, fname, ModeReadOnly);
size := FileSize(f);
new(buf, size);
ReadSample(f, buf);
writeln;
close(f);
readAudioFile := buf;
end;
procedure changePalette(var pic:PictData);
var i:integer; var i:integer;
begin begin
for i := 0 to 15 do for i := 0 to 15 do
@ -61,16 +40,6 @@ begin
PutScreen(pic.pixeldata); PutScreen(pic.pixeldata);
end; end;
procedure loadPic(filename:string;var pic:PictData);
var infile:file;
begin
open(infile, filename, ModeReadonly);
read(infile, pic);
close(infile);
writeln('magic: ', pic.magic, ' mode:', pic.mode);
end;
procedure loadSpriteFrame(var aSprite:Sprite;spriteIndex:integer; procedure loadSpriteFrame(var aSprite:Sprite;spriteIndex:integer;
var sheetFile:file;sheetIndex:integer); var sheetFile:file;sheetIndex:integer);
begin begin
@ -86,132 +55,94 @@ end;
procedure animateSprite(var aSprite:Sprite); procedure animateSprite(var aSprite:Sprite);
var frameIndex:integer; var frameIndex:integer;
frameTime,frameLeft:integer; frameTime,frameLeft:integer;
moveTime,moveLeft:integer;
ydelta:integer; ydelta:integer;
oldX,oldY:integer;
begin begin
ydelta := aSprite.ydelta; ydelta := aSprite.ydelta;
frameIndex := aSprite.curFrame; frameIndex := aSprite.curFrame;
frameTime := aSprite.frameTime; frameTime := aSprite.frameTime;
frameLeft := aSprite.frameLeft; frameLeft := aSprite.frameLeft;
moveTime := aSprite.moveTime; oldX := aSprite.x; oldY := aSprite.y;
moveLeft := aSprite.moveLeft; aSprite.oldX := oldX; aSprite.oldY := oldY;
frameLeft := frameLeft - 1; frameLeft := frameLeft - 1;
if frameLeft <= 0 then if frameLeft <= 0 then
begin begin
frameIndex := frameIndex + 1; frameIndex := frameIndex + 1;
frameLeft := frameTime; frameLeft := aSPrite.frameTime;
aSprite.frameLeft := frameLeft;
aSprite.curFrame := frameIndex; aSprite.curFrame := frameIndex;
if frameIndex >= aSprite.frameCount then if frameIndex >= aSprite.frameCount then
aSprite.curFrame := 0; aSprite.curFrame := 0;
end;
moveLeft := moveLeft - 1; aSprite.frameLeft := frameLeft;
if moveLeft <= 0 then
begin
aSprite.x := aSprite.x + aSprite.xdelta; aSprite.x := aSprite.x + aSprite.xdelta;
aSprite.y := aSprite.y + aSprite.ydelta; aSprite.y := aSprite.y + aSprite.ydelta;
moveLeft := moveTime;
if aSprite.x > 608 then aSprite.x := 0; if aSprite.x > 608 then aSprite.x := 0;
if aSprite.ydelta <> 0 then if aSprite.y < 0 then
begin begin
if aSprite.y < 3 then aSprite.y := 200;
aSprite.ydelta := -aSprite.ydelta aSprite.x := 0;
else
if aSprite.y > 130 then
aSprite.ydelta := -aSprite.yDelta;
end; end;
end; end;
aSprite.frameLeft := frameLeft; aSprite.frameLeft := frameLeft;
aSprite.moveLeft := moveLeft;
end; end;
procedure animLoop; procedure animLoop;
var i:integer; var i:integer;
lastX,lastY:integer; oldX,oldY:integer;
rlastX,rlastY:integer; roldX,roldY:integer;
r2lastX,r2lastY:integer;
r3lastX,r3lastY:integer;
begin begin
stickMan.x := 0; stickMan.x := 0;
stickMan.y := 205; stickMan.y := 310;
stickMan.frameTime := 6; stickMan.frameTime := 6;
stickMan.frameLeft := stickMan.frameTime; stickMan.frameLeft := stickMan.frameTime;
stickMan.curFrame := 0; stickMan.curFrame := 0;
stickMan.xdelta := 2; stickMan.xdelta := 2;
stickMan.ydelta := 0; stickMan.ydelta := 0;
stickMan.moveTime := 2;
stickman.moveLeft := stickMan.moveTime;
rocket.x := 0; rocket.x := 0;
rocket.y := 50; rocket.y := 200;
rocket.frameTime := 5; rocket.frameTime := 1;
rocket.frameLeft := rocket.frameTime; rocket.frameLeft := rocket.frameTime;
rocket.curFrame := 0; rocket.curFrame := 0;
rocket.xdelta := 3; rocket.xdelta := 2;
rocket.ydelta := 1; rocket.ydelta := -1;
rocket.moveTime := 1;
rocket.moveLeft := rocket.moveTime;
rocket2.x := 50;
rocket2.y := 190;
rocket2.frameTime := 5;
rocket2.frameLeft := rocket2.frameTime;
rocket2.curFrame := 1;
rocket2.xdelta := 3;
rocket2.ydelta := 0;
rocket2.moveTime := 1;
rocket2.moveLeft := rocket2.moveTime;
rocket3.x :=100;
rocket3.y := 90;
rocket3.frameTime := 5;
rocket3.frameLeft := rocket3.frameTime;
rocket3.curFrame := 2;
rocket3.xdelta := 3;
rocket3.ydelta := -1;
rocket3.moveTime := 1;
rocket3.moveLeft := rocket3.moveTime;
while not ConAvail do while not ConAvail do
begin begin
lastX := stickMan.x; oldX := stickMan.x;
lastY := stickMan.y; oldY := stickMan.y;
rlastX := rocket.x; roldX := rocket.x;
rlastY := rocket.y; roldY := rocket.y;
r2lastX := rocket2.x; PutSprite(roldX, roldY, rocket.frame[rocket.curFrame]);
r2lastY := rocket2.y; PutSprite(oldX, oldY, stickMan.frame[stickMan.curFrame]);
r3lastX := rocket3.x;
r3lastY := rocket3.y;
PutSprite(rlastX, rlastY, rocket.frame[rocket.curFrame]);
PutSprite(r2lastX, r2lastY, rocket2.frame[rocket2.curFrame]);
PutSprite(r3lastX, r3lastY, rocket3.frame[rocket3.curFrame]);
PutSprite(lastX, lastY, stickMan.frame[stickMan.curFrame]);
animateSprite(rocket); animateSprite(rocket);
animateSprite(rocket2);
animateSprite(rocket3);
animateSprite(stickMan); animateSprite(stickMan);
Delay(10); {Delay(1);}
WaitVSync; WaitVSync;
UndrawSprite(lastX, lastY, pic.pixeldata); UndrawSprite(oldX, oldY, pic.pixeldata);
UndrawSprite(rlastX, rlastY, pic.pixeldata); UndrawSprite(roldX, roldY, pic.pixeldata);
UndrawSprite(r2lastX, r2lastY, pic.pixeldata);
UndrawSprite(r3lastX, r3lastY, pic.pixeldata);
end; end;
end; end;
begin begin
loadPic('background.pict', pic); filename := 'background.pict';
open(infile, filename, ModeReadonly);
read(infile, pic);
close(infile);
writeln('magic: ', pic.magic, ' mode:', pic.mode);
loadPalette(pic); loadPalette(pic);
showPic(pic); showPic(pic);
@ -229,14 +160,5 @@ begin
loadSpriteFrame(rocket, 3, infile, 3); loadSpriteFrame(rocket, 3, infile, 3);
close(infile); close(infile);
rocket2 := rocket;
rocket3 := rocket;
buf := readAudioFile('footsteps.tdrau');
SampleQStart(buf, true, 16000);
animLoop; animLoop;
SampleQStop;
dispose(buf);
end. end.

Binary file not shown.

View file

@ -1,19 +0,0 @@
JASC-PAL
0100
16
0 0 0
255 255 255
255 0 0
0 255 0
0 0 255
0 255 255
255 0 255
255 255 0
127 127 127
160 160 160
127 0 0
0 127 0
0 0 127
0 127 127
127 0 127
127 127 0

View file

@ -106,7 +106,7 @@ begin
end; end;
begin begin
readSpriteData('sprite-testcard.sprt'); readSpriteData('rocket.sprt');
InitGraphics; InitGraphics;
startBench('points 200K'); startBench('points 200K');

Binary file not shown.

Binary file not shown.

View file

@ -53,9 +53,9 @@ CALC_VMEM_ADDR:
.EQU PS_SPILL 24 .EQU PS_SPILL 24
.EQU PS_STRIPE_C 28 .EQU PS_STRIPE_C 28
.EQU PS_BPSAVE 32 .EQU PS_BPSAVE 32
.EQU PS_FS_ 36 .EQU PS_FS 36
PUTSPRITE: PUTSPRITE:
FPADJ -PS_FS_ FPADJ -PS_FS
STORE PS_SPRITE_DATA STORE PS_SPRITE_DATA
STORE PS_Y STORE PS_Y
STORE PS_X STORE PS_X
@ -175,7 +175,7 @@ PS_L_XT:
LOAD PS_BPSAVE LOAD PS_BPSAVE
STOREREG BP STOREREG BP
FPADJ PS_FS_ FPADJ PS_FS
RET RET
; undraw a sprite, i.e. draw background data ; undraw a sprite, i.e. draw background data

Binary file not shown.

View file

@ -977,7 +977,7 @@ SETPALETTE:
DEFAULT_PALETTE: DEFAULT_PALETTE:
.WORD 0, $FFF, $F00, $0F0, $00F, $0FF, $F0F, $FF0 .WORD 0, $FFF, $F00, $0F0, $00F, $0FF, $F0F, $FF0
.WORD $777, $AAA, $700, $070, $007, $077, $707, $770 .WORD $777, $777, $700, $070, $007, $077, $707, $770
; set whole video memory to zero ; set whole video memory to zero
CLEARGRAPHICS: CLEARGRAPHICS:

View file

@ -1,7 +1,6 @@
type SndBuf = string[32768]; type SndBuf = string[32768];
type SndBufPtr = ^SndBuf; type SndBufPtr = ^SndBuf;
procedure ReadSample(aFile:file;buf:SndBufPtr); external;
procedure PlaySample(buf:SndBufPtr;sampleRate:integer); external; procedure PlaySample(buf:SndBufPtr;sampleRate:integer); external;
procedure SampleQStart(buf:SndBufPtr;loop:boolean;sampleRate:integer); external; procedure SampleQStart(buf:SndBufPtr;loop:boolean;sampleRate:integer); external;
procedure SampleQStop; external; procedure SampleQStop; external;

View file

@ -302,22 +302,3 @@ SMPLQ_I_XT2:
DROP DROP
LOADREG IR ; jump via interrupt return register LOADREG IR ; jump via interrupt return register
JUMP JUMP
; args: file ptr, ptr to SndBuf (i.e. a String)
READSAMPLE:
; buf ptr + 0: addr of cur size header field
; buf ptr + 4: addr of max size header field
; buf ptr + 8: start of raw data
; copy max size to current size header field of SndBuf
INC.S1.X2Y 4 ; [ file ptr, buf ptr, buf ptr+4 ]
LOADI ; [ file ptr, buf ptr, max size ]
STOREI 8 ; [ file ptr, buf ptr+8 ]
; put max size back on ToS
DUP ; [ file ptr, buf ptr+8, buf ptr+8]
DEC 4 ; [ file ptr, buf ptr+8, buf ptr+4]
LOADI ; [ file ptr, buf ptr+8, max size ]
LOADCP READFS
CALL
RET

View file

@ -1792,38 +1792,6 @@ MAX_XT:
FPADJ 4 FPADJ 4
RET RET
; find largest free chunk on heap
; args: none
; returns: size of largest free chunk in bytes
MAXAVAIL:
FPADJ -4
LOADC 0
STORE 0 ; start with zero as result
LOADCP _HEAP_ANCHOR
MXAV_L:
DUP ; dup chunk ptr for later
INC 4 ; move to size field
LOADI ; load chunk size
LOAD 0 ; compare with current result value
CMPU.S0 LE ; compare with keeping first arg on stack
CBRANCH MXAV_NEXT ; if smaller or equal, no change
STORE 0 ; else store as new value
BRANCH MXAV_NEXT2
MXAV_NEXT:
DROP
MXAV_NEXT2:
LOADI ; load next ptr
DUP
LOADCP _HEAP_ANCHOR ; compare with anchor
CMPU NE
CBRANCH MXAV_L ; if not equal, loop
MXAV_XT:
DROP ; drop chunk ptr
LOAD 0 ; put result value on stack
FPADJ 4
RET
; check if a pointer is part of the free list ; check if a pointer is part of the free list
; args: pointer returned by MEM_ALLOC ; args: pointer returned by MEM_ALLOC
; throws runtime error if the pointer is found ; throws runtime error if the pointer is found

View file

@ -150,7 +150,6 @@ procedure strmoveup(var s:string;index,length,delta:integer); external;
procedure strmovedown(var s:string;index,length,delta:integer); external; procedure strmovedown(var s:string;index,length,delta:integer); external;
procedure RuntimeError(var s:string); external; procedure RuntimeError(var s:string); external;
function MemAvail:integer; external; function MemAvail:integer; external;
function MaxAvail:integer; external;
(* from stdlib *) (* from stdlib *)
function copy(s:string[256];index,count:integer):string[256]; external; function copy(s:string[256];index,count:integer):string[256]; external;

View file

@ -1,18 +0,0 @@
program testmem;
var s1:^string[2048];
s2:^string[2048];
begin
writeln(MemAvail);
writeln(MaxAvail);
writeln('new s1 and s2');
new(s1);
new(s2);
writeln(MemAvail);
writeln(MaxAvail);
writeln('dispose s1');
dispose(s1);
writeln(MemAvail);
writeln(MaxAvail);
end.

View file

@ -249,7 +249,6 @@ func (c *CPU) step() error {
var name string var name string
if (insWord & 1) == 1 { if (insWord & 1) == 1 {
name = "STORE.B" name = "STORE.B"
operand &= ^1
ea = c.BP + word(operand) ea = c.BP + word(operand)
} else { } else {
name = "STORE" name = "STORE"

View file

@ -10,16 +10,11 @@ import (
const VmemWords = 32768 const VmemWords = 32768
const PaletteSlots = 16 const PaletteSlots = 16
const FB_RA = 0 const FB_RA = 0
const FB_WA = 4 const FB_WA = 1
const FB_IO = 8 const FB_IO = 2
const FB_PS = 12 const FB_PS = 3
const FB_PD = 16 const FB_PD = 4
const FB_CTL= 20 const FB_CTL= 5
const FB_SHIFTER = 24
const FB_SHIFTCOUNT = 28
const FB_SHIFTERM = 32
const FB_SHIFTERSP = 36
const FB_MASKGEN = 40
const PixelMask = 0b11110000000000000000000000000000 const PixelMask = 0b11110000000000000000000000000000
const PixelPerWord = 8 const PixelPerWord = 8
@ -38,9 +33,6 @@ type Framebuffer struct {
vmem [VmemWords]word vmem [VmemWords]word
readCount int readCount int
paletteChanged bool paletteChanged bool
shiftAssistData word
shiftAssistCount int
maskGenData word
} }
func (f *Framebuffer) initialize() { func (f *Framebuffer) initialize() {
@ -61,11 +53,6 @@ func (f *Framebuffer) read(byteaddr word) (word, error) {
case FB_PS: result = f.paletteSlot case FB_PS: result = f.paletteSlot
case FB_PD: result = f.readPalette() case FB_PD: result = f.readPalette()
case FB_CTL: result = f.readCtl() case FB_CTL: result = f.readCtl()
case FB_SHIFTER: result = f.readShiftAssist()
case FB_SHIFTCOUNT: result = 0xFFFFFFF
case FB_SHIFTERM: result = f.readShifterM()
case FB_SHIFTERSP: result = f.readShifterSp()
case FB_MASKGEN: result = f.readMaskGen()
default: default:
} }
return result, nil return result, nil
@ -80,11 +67,6 @@ func (f *Framebuffer) write(value word, byteaddr word) (error) {
case FB_PS: f.paletteSlot = value case FB_PS: f.paletteSlot = value
case FB_PD: f.writePalette(value) case FB_PD: f.writePalette(value)
case FB_CTL: f.writeCtl(value) case FB_CTL: f.writeCtl(value)
case FB_SHIFTER: f.writeShiftAssist(value)
case FB_SHIFTCOUNT: f.writeShiftCount(value)
case FB_SHIFTERM:
case FB_SHIFTERSP:
case FB_MASKGEN: f.writeMaskGen(value)
default: default:
} }
@ -170,47 +152,3 @@ func (f *Framebuffer) readCtl() word {
func (f *Framebuffer) writeCtl(value word) { func (f *Framebuffer) writeCtl(value word) {
} }
func (f *Framebuffer) writeShiftAssist(value word) {
f.shiftAssistData = value
f.shiftAssistCount = 0
}
func (f *Framebuffer) readShiftAssist() word {
return f.shiftAssistData >> (f.shiftAssistCount * 4)
}
func (f *Framebuffer) writeShiftCount(value word) {
f.shiftAssistCount = int(value & 0x7)
}
func (f *Framebuffer) readShifterM() word {
return convertToMask(f.readShiftAssist())
}
func pixelToMask(pixels word, mask word) word {
if (pixels & mask) != 0 { return mask } else { return 0 }
}
func convertToMask(pixels word) word {
return pixelToMask(pixels, 0xF0000000) |
pixelToMask(pixels, 0x0F000000) |
pixelToMask(pixels, 0x00F00000) |
pixelToMask(pixels, 0x000F0000) |
pixelToMask(pixels, 0x0000F000) |
pixelToMask(pixels, 0x00000F00) |
pixelToMask(pixels, 0x000000F0) |
pixelToMask(pixels, 0x0000000F)
}
func (f *Framebuffer) readShifterSp() word {
return word(f.shiftAssistData << ((8-f.shiftAssistCount)*4))
}
func (f *Framebuffer) writeMaskGen(value word) {
f.maskGenData = value
}
func (f *Framebuffer) readMaskGen() word {
return convertToMask(f.maskGenData)
}

View file

@ -620,9 +620,6 @@ def create_image_with_stuff(imgfile):
slotnr = putfile("../examples/background.pict", None , f, part, partstart, slotnr) slotnr = putfile("../examples/background.pict", None , f, part, partstart, slotnr)
slotnr = putfile("../examples/walking.sprt", None , f, part, partstart, slotnr) slotnr = putfile("../examples/walking.sprt", None , f, part, partstart, slotnr)
slotnr = putfile("../examples/rocket.sprt", None , f, part, partstart, slotnr) slotnr = putfile("../examples/rocket.sprt", None , f, part, partstart, slotnr)
slotnr = putfile("../examples/sprite-testcard.sprt", None , f, part, partstart, slotnr)
slotnr = putfile("../examples/tiles.inc", None , f, part, partstart, slotnr)
slotnr = putfile("../examples/tiles.s", None , f, part, partstart, slotnr)
listdir(f, part) listdir(f, part)