Apple-2gs-SW
/
gslib
mirror of https://github.com/digarok/gslib.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

add files missing since back in the day

This commit is contained in:
Dagen Brock 2022-08-14 09:37:18 -05:00
parent eee59bd34e
commit 308584bd59
25 changed files with 1701 additions and 582 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
README.md
View File

@ -16,3 +16,6 @@ Source Files in "Lesson" Order
* shrhello.s "Hello World", Example program showing how to use the font routines
* shrloadimg.s SHRLoadImage, Loads a PackBytes image and unpacks it to screen
* shrloadimg.m.s macros for ToolBox calls in SHRLoadImage
* demo.s the final demo project with sprites and music
https://youtu.be/NKB44MSod3o

39
appy.yaml Normal file
View File

@ -0,0 +1,39 @@
assemble:
- src/quit.s
- src/quit8.s
- src/quit16.s
- src/shr1.s
- src/shr2.s
- src/shrhello.s
- src/shrloadimg.s
- src/demo.s
disks:
- name: gslib
file: gslib.2mg
size: 800KB
files:
- input: src/quit
output: /gslib
- input: src/quit8.system
output: /gslib
- input: src/quit16.sys16
output: /gslib
- input: src/shr1
output: /gslib
- input: src/shr2
output: /gslib
- input: src/shrhello
output: /gslib
- input: src/shrloadimg
output: /gslib
- input: src/demo.sys16
output: /gslib
- input: content/KFEST2013B.PAK
output: /gslib
- input: content/torus00.bin
output: /gslib
- input: content/song3.nt
output: /gslib

BIN
content/KFEST2013B.PAK Normal file
View File

Binary file not shown.

BIN
content/song3.nt Normal file
View File

Binary file not shown.

BIN
content/torus00.bin Normal file
View File

Binary file not shown.

26
source/quit16.s
View File

@ -1,26 +0,0 @@
****************************************
* Quit16 *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-06-10 *
****************************************
rel ; compile as relocatable code
dsk Quit16.l ; Save Name
phk ; Set Data Bank to Program Bank
plb ; Always do this first!
jsl $E100A8 ; Prodos 16 entry point
da $29 ; Quit code
adrl QuitParm ; address of parameter table
bcs Error ; never taken
Error brk ; should never get here
QuitParm adrl $0000 ; pointer to pathname (not used here)
da $00 ; quit type (absolute quit)

29
source/quit8.s
View File

@ -1,29 +0,0 @@
****************************************
* Quit8 *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-06-24 *
****************************************
org $2000 ; start at $2000 (all ProDOS8 system files)
dsk quit8.system ; tell compiler what name for output file
typ $ff ; set P8 type ($ff = "SYS") for output file
MLI equ $bf00
Quit jsr MLI ; first actual command, call ProDOS vector
dfb $65 ; with "quit" request ($65)
da QuitParm
bcs Error
brk $00 ; shouldn't ever here!
QuitParm dfb 4 ; number of parameters
dfb 0 ; standard quit type
da $0000 ; not needed when using standard quit
dfb 0 ; not used
da $0000 ; not used
Error brk $00 ; shouldn't be here either

64
source/shr1.s
View File

@ -1,64 +0,0 @@
****************************************
* SHR1 *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-17 *
****************************************
rel ; Compile
dsk SHR1.l ; Save Name
mx %00 ; Program starts in 16-bit mode
phk ; Set Data Bank to Program Bank
plb ; Always do this first!
GraphicsOn sep #$30 ; 8-bit mode
lda #$81
stal $00C029 ; Turn on SHR mode
rep #$30 ; back to 16-bit mode
jsr WaitKey ; pause
ClearNaive ldx #$0000 ; Start at first pixel
lda #$0000 ; store zeros
:clearloop stal $E12000,x ; screen location
inx
inx
cpx #$8000 ; see if we've filled entire frame/colors/scbs
bne :clearloop ; pause
jsr WaitKey
ClearFaster ldx #$7FFE ; start at top this time
lda #$0000 ; store zeros
:clearloop stal $E12000,x ; screen location
dex
dex
; avoid 16K "compare X's" for 80K cycle savings
bne :clearloop ; loop until we've worked our way down to 0
jsr WaitKey
jsl $E100A8 ; Prodos 16 entry point
da $29 ; Quit code
adrl QuitParm ; address of parameter table
bcs Error ; never taken
Error brk ; should never get here
QuitParm adrl $0000 ; pointer to pathname (not used here)
da $00 ; quit type (absolute quite)
WaitKey sep #$30 ; good old apple ii key wait routine
:wait ldal $00C000 ; but called using long addressing modes
bpl :wait ; in 8-bit mode
stal $00C010
rep #$30
rts

86
source/shr2.s
View File

@ -1,86 +0,0 @@
****************************************
* SHR2 *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-17 *
****************************************
rel ;Compile
dsk SHR2.l ;Save Name
mx %00 ;Program starts in 16-bit mode
phk ;Set Data Bank to Program Bank
plb ;Always do this first!
lda #$0FFF ; WHITE color
ldx #$0001 ; palette index 1 (NOT zero)
jsr SetPaletteColor
lda #$0000
jsr SetSCBs ;set all SCBs to 00 (320 mode, pal 0, no fill, no interrupt)
jsr ClearToColor ;clear screen (fill with zeros)
jsr GraphicsOn ;turn on SHR
jsr WaitKey
lda #$1111 ;clear screen to color 1
jsr ClearToColor
jsr WaitKey
jsl $E100A8 ;Prodos 16 entry point
da $29 ;Quit code
adrl QuitParm ;address of parameter table
bcs Error ;never taken
Error brk ;should never get here
QuitParm adrl $0000 ;pointer to pathname (not used here)
da $00 ;quit type (absolute quite)
****************************************
* Turn on SHR mode *
****************************************
GraphicsOn sep #$30 ;8-bit mode
lda #$81 ;%1000 0001
stal $00C029 ;Turn on SHR mode
rep #$30 ;back to 16-bit mode
rts
****************************************
* A= color values (0RGB) *
* X= color/palette offset *
* (0-F = pal0, 10-1F = pal1, etc.) *
****************************************
SetPaletteColor pha ;save accumulator
txa
asl ;X*2 = real offset to color table
tax
pla
stal $E19E00,x ;palettes are stored from $E19E00-FF
rts ;yup, that's it
****************************************
* A= color values (0RGB) *
****************************************
ClearToColor ldx #$7D00 ;start at top of pixel data! ($2000-9D00)
:clearloop dex
dex
stal $E12000,x ;screen location
bne :clearloop ;loop until we've worked our way down to 0
rts
SetSCBs ldx #$0100 ;set all $100 scbs to A
:scbloop dex
dex
stal $E19D00,x
bne :scbloop
rts
WaitKey sep #$30
:wait ldal $00C000
bpl :wait
stal $00C010
rep #$30
rts

99
source/shrhello.s
View File

@ -1,99 +0,0 @@
****************************************
* SHRHELLO *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-21 *
****************************************
rel ; Compile
dsk SHRHELLO.l ; Save Name
mx %00
phk ; Set Data Bank to Program Bank
plb ; Always do this first!
lda #$0FFF ; WHITE color
ldx #$000F ; palette index 1 (NOT zero)
jsr SetPaletteColor
lda #$0589 ; other color
ldx #$0001 ; palette index 1 (NOT zero)
jsr SetPaletteColor
lda #$0000
jsr SetSCBs ; set all SCBs to 00 (320 mode, pal 0, no fill, no interrupt)
jsr GraphicsOn
lda #$0000 ; clear screen to color 0 and turn on SHR graphics
jsr ClearToColor
lda #HelloStr
ldx #60*160+30
jsr DrawString
jsr WaitKey
lda #$1111 ; clear screen to color 1
jsr ClearToColor
lda #HelloStr
ldx #60*160+30
jsr DrawString
jsr WaitKey
jsl $E100A8 ; Prodos 16 entry point
da $29 ; Quit code
adrl QuitParm ; address of parameter table
bcs Error ; never taken
Error brk ; should never get here
QuitParm adrl $0000 ; pointer to pathname (not used here)
da $00 ; quit type (absolute quite)
HelloStr str 'HELLO KANSASFEST'
****************************************
* Turn on SHR mode *
****************************************
GraphicsOn sep #$30 ;8-bit mode
lda #$81 ;%1000 0001
stal $00C029 ;Turn on SHR mode
rep #$30 ;back to 16-bit mode
rts
****************************************
* A= color values (0RGB) *
* X= color/palette offset *
* (0-F = pal0, 10-1F = pal1, etc.) *
****************************************
SetPaletteColor pha ;save accumulator
txa
asl ;X*2 = real offset to color table
tax
pla
stal $E19E00,x ;palettes are stored from $E19E00-FF
rts ;yup, that's it
****************************************
* A= color values (0RGB) *
****************************************
ClearToColor ldx #$7D00 ;start at top of pixel data! ($2000-9D00)
:clearloop dex
dex
stal $E12000,x ;screen location
bne :clearloop ;loop until we've worked our way down to 0
rts
SetSCBs ldx #$0100 ;set all $100 scbs to A
:scbloop dex
dex
stal $E19D00,x
bne :scbloop
rts
WaitKey sep #$30
:wait ldal $00c000
bpl :wait
stal $00c010
rep #$30
rts
use FONT ;include our font library

266
source/shrloadimg.s
View File

@ -1,266 +0,0 @@
****************************************
* SHRLOADIMG *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-21 *
****************************************
rel ; Compile
dsk SHRLOADIMG.l ; Save Name
use shrloadimg.m
mx %00 ; Program starts in 16-bit mode
****************************************
* Basic Error Macro *
****************************************
_Err mac
bcc NoErr
do ]0 ; (DO if true)
jsr PgmDeath ; this is conditionally compiled if
str ]1 ; we pass in an error statement
else ; (ELSE)
jmp PgmDeath0 ; we just call the simpler error handler
fin ; (FIN)
NoErr eom
****************************************
* Program Start *
****************************************
phk ; Set Data Bank to Program Bank
plb ; Always do this first!
****************************************
* Typical tool startup *
****************************************
_TLStartUp ; normal tool initialization
pha
_MMStartUp
_Err ; should never happen
pla
sta MasterId ; our master handle references the memory allocated to us
ora #$0100 ; set auxID = $01 (valid values $01-0f)
sta UserId ; any memory we request must use our own id
****************************************
* Initialize graphics *
****************************************
jsr AllocOneBank ; Alloc 64KB for Load/Unpack
sta BankLoad ; Store "Bank Pointer"
ldx #ImageName ; Load+Unpack Boot Picture
jsr LoadPicture ; X=Name, A=Bank to use for loading
lda BankLoad ; get address of loaded/uncompressed picture
clc
adc #$0080 ; skip header?
sta :copySHR+2 ; and store that over the 'ldal' address below
ldx #$7FFE ; copy all image data
:copySHR ldal $000000,x ; load from BankLoad we allocated
stal $E12000,x ; store to SHR screen
dex
dex
bpl :copySHR
jsr GraphicsOn
jsr WaitKey
bra Quit
ImageName strl '1/KFEST2013.PAK'
MasterId ds 2
UserId ds 2
BankLoad hex 0000 ; used for Load/Unpack
Quit jsl $E100A8 ; Prodos 16 entry point
da $29 ; Quit code
adrl QuitParm ; address of parameter table
bcs Error ; never taken
Error brk ; should never get here
QuitParm adrl $0000 ; pointer to pathname (not used here)
da $00 ; quit type (absolute quite)
****************************************
* AllocOneBank *
* This is a custom allocation function *
* that makes use of the fact that we *
* request an entire locked bank and so *
* simply returns the bank in the *
* accumulator. (basically dereference *
* the Handle to get the pointer) *
****************************************
AllocOneBank PushLong #0
PushLong #$10000
PushWord UserId
PushWord #%11000000_00011100
PushLong #0
_NewHandle ; returns LONG Handle on stack
plx ; base address of the new handle
pla ; high address 00XX of the new handle (bank)
xba ; swap accumulator bytes to XX00
sta :bank+2 ; store as bank for next op (overwrite $XX00)
:bank ldal $000001,X ; recover the bank address in A=XX/00
rts
****************************************
* Graphics Helpers *
****************************************
LoadPicture jsr LoadFile ; X=Nom Image, A=Banc de chargement XX/00
bcc :loadOK
brl Exit
:loadOK jsr UnpackPicture ; A=Packed Size
rts
UnpackPicture sta UP_PackedSize ; Size of Packed Data
lda #$8000 ; Size of output Data Buffer
sta UP_UnPackedSize
lda BankLoad ; Banc de chargement / Decompression
sta UP_Packed+1 ; Packed Data
clc
adc #$0080
stz UP_UnPacked ; On remet a zero car modifie par l'appel
stz UP_UnPacked+2
sta UP_UnPacked+1 ; Unpacked Data buffer
PushWord #0 ; Space for Result : Number of bytes unpacked
PushLong UP_Packed ; Pointer to buffer containing the packed data
PushWord UP_PackedSize ; Size of the Packed Data
PushLong #UP_UnPacked ; Pointer to Pointer to unpacked buffer
PushLong #UP_UnPackedSize ; Pointer to a Word containing size of unpacked data
_UnPackBytes
pla ; Number of byte unpacked
rts
UP_Packed hex 00000000 ; Address of Packed Data
UP_PackedSize hex 0000 ; Size of Packed Data
UP_UnPacked hex 00000000 ; Address of Unpacked Data Buffer (modified)
UP_UnPackedSize hex 0000 ; Size of Unpacked Data Buffer (modified)
****************************************
* Turn on SHR mode *
****************************************
GraphicsOn sep #$30 ; 8-bit mode
lda #$C1
stal $00C029 ; Turn on SHR mode
rep #$30 ; back to 16-bit mode
rts
WaitKey sep #$30
:wait ldal $00C000
bpl :wait
stal $00C010
rep #$30
rts
****************************************
* Fatal Error Handler *
****************************************
PgmDeath tax
pla
inc
phx
phk
pha
bra ContDeath
PgmDeath0 pha
pea $0000
pea $0000
ContDeath ldx #$1503
jsl $E10000
****************************************
* Normal GSOS Quit *
****************************************
Exit jsl GSOS
dw $2029
adrl QuitGS
****************************************
* GS/OS / ProDOS 16 File Routines *
****************************************
GSOS = $E100A8
LoadFile stx OpenGS+4 ; X=File, A=Bank/Page XX/00
sta ReadGS+5
:openFile jsl GSOS ; Open File
dw $2010
adrl OpenGS
bcs :openReadErr
lda OpenGS+2
sta GetEOFGS+2
sta ReadGS+2
jsl GSOS ; Get File Size
dw $2019
adrl GetEOFGS
lda GetEOFGS+4
sta ReadGS+8
lda GetEOFGS+6
sta ReadGS+10
jsl GSOS ; Read File Content
dw $2012
adrl ReadGS
bcs :openReadErr
:closeFile jsl GSOS ; Close File
dw $2014
adrl CloseGS
clc
lda GetEOFGS+4 ; File Size
rts
:openReadErr jsr :closeFile
nop
nop
PushWord #0
PushLong #msgLine1
PushLong #msgLine2
PushLong #msgLine3
PushLong #msgLine4
_TLTextMountVol ; actualname is TLTextMountVolume
pla
cmp #1
bne :loadFileErr
brl :openFile
:loadFileErr sec
rts
msgLine1 str 'Unable to load File'
msgLine2 str 'Press a key :'
msgLine3 str ' -> Return to Try Again'
msgLine4 str ' -> Esc to Quit'
OpenGS dw 2 ; pCount
ds 2 ; refNum
adrl ImageName ; pathname
GetEOFGS dw 2 ; pCount
ds 2 ; refNum
ds 4 ; eof
ReadGS dw 4 ; pCount
ds 2 ; refNum
ds 4 ; dataBuffer
ds 4 ; requestCount
ds 4 ; transferCount
CloseGS dw 1 ; pCount
ds 2 ; refNum
QuitGS dw 2 ; pCount
ds 4 ; pathname
ds 2 ; flags

971
src/demo.s Normal file
View File

@ -0,0 +1,971 @@
*--------------------------------------*
* Graphics and Sound Library Example *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-06-10 *
*--------------------------------------*
rel
dsk demo.sys16.l
typ $B3
use gslib.mac
use skel.macgen
lst off
*--------------------------------------*
* Basic Error Macro *
*--------------------------------------*
_Err mac
bcc NoErr
do ]0 ; (DO if true)
jsr PgmDeath ; this is conditionally compiled if
str ]1 ; we pass in an error statement
else ; (ELSE)
jmp PgmDeath0 ; we just call the simpler error handler
fin ; (FIN)
NoErr eom
*--------------------------------------*
* Initialize environment *
*--------------------------------------*
Start clc
xce
rep $30 ; set full 16-bit mode
phk ; set bank - always do this at
plb ; the beginning of a GSOS program
* tsc ; not sure about this?
* sec
* sbc #$10
* tcs
* inc
* tcd
_TLStartUp ; normal tool initialization
pha
_MMStartUp
_Err ; should never happen
pla
sta MasterId ; our master handle references the memory allocated to us
ora #$0100 ;
sta UserId ; any memory we request must use our own id
*--------------------------------------*
* Initialize graphics *
*--------------------------------------*
jsr AllocOneBank ; Alloc 64KB for Load/Unpack
sta BankLoad ; Store "Bank Pointer"
ldx #ImageName ; Load+Unpack Boot Picture
jsr LoadPicture ; X=Name, A=Bank to use for loading
jsr AllocOneBank ; Alloc 64KB for Sprite binary data
sta BankSprite ; Store "Bank Pointer"
sta torusBank00+2
ldx #Sprite00Name ; Pointer to filename
lda BankSprite ; "Bank Pointer" to sprite memory
jsr LoadFile ; Load File
*--------------------------------------*
* Initialize sound *
*--------------------------------------*
pea #0220 ; Tool220
pea $0105 ; Version Min
ldx #$0F01 ; LoadOneTool
jsl $E10000
_Err "Tool220 (min v1.05) not Found! : $"
PushLong #0 ; Allocate Direct Page in Bank 00
PushLong #$000100
PushWord UserId
PushWord #$C001 ; Allocation parms
PushLong #0
_NewHandle
_Err "Can't Allocate ZPage! : $"
pla
sta $00
pla
sta $02
lda [$00] ; PageZero
pha
_NTStartUp
_Err
lda #ModuleName
ldx #^ModuleName
jsr ReadFile
_Err "Module Not Found! : $"
pei $06 ; ^@ModuleAdr
pei $04 ; @ModuleAdr (Must be Page aligned !!!)
ldx #$09DC ; NTInitMusic
jsl $E10000
_Err
_NTLaunchMusic
_Err
;; here?
jsr StartGraphicMode ; Display Graphic Page, activate Shadowing...
lda BankLoad ; Display Boot Picture
clc
adc #$0080 ; offset by 128 bytes?
jsr FadeIn ; A=XX/YY00 of the image
;; to here
stal $E1C010
MainLoop
:vbl ldal $E1C02E ; vblank - move it
and #$00FF
cmp #$00D0
bne :vbl
jsr UpdateDemoState
jsr HandleDemoState
pha
ldx #$0BDC ; NTUpdateSound
jsl $E10000
_Err
pla ; EndOfMusic (0,1 or -1)
****
cmp #1
bcs EndMusic
jsr MouseClick ; Exit ?
bcs EndMusic
ldal $E1BFFF
bpl MainLoop
EndMusic jsr ExitGraphic
_NTStopMusic
_Err
_NTShutDown
_Err
lda UserId
pha
ldx #$1102 ; Dispose All
jsl $E10000
_Err
lda MasterId
pha
_MMShutDown
_Err
jsl $E100A8
da $0029
adrl QuitParm
QuitParm da 0
adrl 0
da 0
MasterId ds 2
UserId ds 2
ExitGraphic lda #$0
ldx #$7cfe
:loop stal $e12000,x
dex
dex
bpl :loop
lda #Str9
ldx #0
jsr DrawString
rts
DemoCounter hex 0000
RepeatIndex hex 0000 ; stupid frame skip mechanism
TorusLoc1 equ #160*70+5+$2000
TorusLoc2 equ #160*70+14+$2000
TorusLoc3 equ #160*70+22+$2000
Torii dw #07
TorusLocs dw #160*70+5+$2000+10
dw #160*70+25+$2000+10
dw #160*70+45+$2000+10
dw #160*70+65+$2000+10
dw #160*70+85+$2000+10
dw #160*70+105+$2000+10
dw #160*70+125+$2000+10
TorusFrames dw #00
dw #10
dw #08
dw #16
dw #20
dw #30
dw #44
UndrawTorii
ldx Torii
:nextUndraw dex ;switch natural number to 0-index
phx
txa
asl
tax
lda TorusLocs,x
tay
lda #60
jsr Drawtorus ;blackout
plx
cpx #$0 ;done?
bne :nextUndraw
rts
DrawTorii
ldx Torii
:next dex ;switch natural number to 0-index
phx
txa
asl
tax
lda TorusLocs,x
tay
lda TorusFrames,x
jsr Drawtorus
plx
cpx #$0 ;done drawing all torii
bne :next
rts
UpdateTorii
ldy Torii
:nextUpdate dey ;switch natural number to 0-index
tya
asl
tax
lda TorusFrames,x
inc
cmp #60 ;reset frame counter
bne :not
lda #$0
:not sta TorusFrames,x
cpy #$0
bne :nextUpdate
rts
UpdateSprite
jsr UndrawTorii
jsr DrawTorii
inc RepeatIndex ; ghetto fram skip
lda RepeatIndex
cmp #04
bne :noAdvance
stz RepeatIndex
;; do stuff
jsr UpdateTorii
:noAdvance
:done rts
ScrollTop equ $e12000+#160*80
Scroll
ldx #$00
ldy #158
:scloop ldal ScrollTop+2,x ;#80*160
stal ScrollTop,x
ldal ScrollTop+2+160,x ;2
stal ScrollTop+160,x
ldal ScrollTop+2+320,x ;3
stal ScrollTop+320,x
ldal ScrollTop+2+480,x ;4
stal ScrollTop+480,x
ldal ScrollTop+2+640,x ;5
stal ScrollTop+640,x
ldal ScrollTop+2+800,x ;6
stal ScrollTop+800,x
* ldal ScrollTop+2+960,x ;7
* stal ScrollTop+960,x
* ldal ScrollTop+2+1120,x ;7
* stal ScrollTop+1120,x
* ldal ScrollTop+2+1280,x ;7
* stal ScrollTop+1280,x
* ldal ScrollTop+2+1440,x ;7
* stal ScrollTop+1440,x
* ldal ScrollTop+2+1600,x ;7
* stal ScrollTop+1600,x
* ldal ScrollTop+2+1760,x ;7
* stal ScrollTop+1760,x
* ldal ScrollTop+2+1920,x ;7
* stal ScrollTop+1920,x
* ldal ScrollTop+2+2080,x ;7
* stal ScrollTop+2080,x
* ldal ScrollTop+2+2240,x ;7
* stal ScrollTop+2240,x
* ldal ScrollTop+2+2400,x ;7
* stal ScrollTop+2400,x
* ldal ScrollTop+2+2560,x ;7
* stal ScrollTop+2560,x
* ldal ScrollTop+2+2720,x ;7
* stal ScrollTop+2720,x
* ldal ScrollTop+2+2880,x ;7
* stal ScrollTop+2880,x
* ldal ScrollTop+2+3040,x ;7
* stal ScrollTop+3040,x
inx
inx
dey
dey
beq :done
brl :scloop
:done rts
ReadFile sta Parm0
stx Parm0+2
jsl $E100A8
da $10 ; Open
adrl Params
bcc *+3
rts
jsl $E100A8
da $19
adrl Params
bcc No_ErrGetEof
pha
jsr Go_Close
pla
sec
rts
No_ErrGetEof pha
pha
lda Parm0+2
sta Parm1+2
pha
lda Parm0
sta Parm1
pha
lda UserId
pha
pea $C00C ; Page Aligned!!!
pea $0
pea $0
ldx #$0902 ; NewHandle
jsl $E10000
_Err "Out Of Memory Error! : $"
pla
sta $00
pla
sta $02
ldy #2
lda [$00],Y
sta Parm0+2
tax
lda [$00]
sta Parm0
sta $04
stx $06
jsl $E100A8
da $12 ; Read
adrl Params
bcc Go_Close
pha
pei $02 ; Free mem
pei $00
ldx #$1002 ; Dispose
jsl $E10000
_Err
jsr Go_Close
pla
sec
rts
Go_Close jsl $E100A8
da $14 ; Close
adrl Params
rts
Params da 0
Parm0 adrl 0
Parm1 adrl 0
adrl 0
*-------------------------------------------------
PgmDeath tax
pla
inc
phx
phk
pha
bra ContDeath
PgmDeath0 pha
pea $0000
pea $0000
ContDeath ldx #$1503
jsl $E10000
** SPRITE / PIC / MEMORY STUFF
BankLoad hex 0000 ; used for Load/Unpack
BankSprite hex 0000
StackAddress hex 0000
ImageName strl '1/KFEST2013B.PAK'
Sprite00Name strl '1/torus00.bin'
ModuleName str 'SONG3.NT' ; Module to be played
*****
* NEW NEW NEW
* NEWNEW
*****
Str1 str 'GREETINGS FROM KANSASFEST' ;30
Str2 str 'GREETINGS TO OZKFEST' ;40
Str3 str 'SORRY IT',27,'S NOT A BIGGER DEMO' ;24
Str4 str 'THANKS TO BRUTAL DELUXE' ;34
Str6 str 'THANKS TO KFEST STAFF & ATTENDEES!' ;14
Str5 str 'MEGA THANKS TO YOU THE VIEWER!!' ;26
Str7 str 'OK... I',27,'M TIRED ;)' ;42
Str8 str 'DIGAROK - 2013' ;52
Str9 str 'THAT',27,'S ALL FOLKS'
MODE_NOP equ 0000
MODE_TORUS equ 0001
MODE_STR1 equ 0002
MODE_STR2 equ 0003
MODE_SCROLL equ 0009
MODE dw 0000
seconds equ #60
UpdateDemoState
inc DemoCounter
lda DemoCounter
* Draw Str1
cmp #3*seconds-5
bne :next1
lda #Str1 ;draw str1 @ 2 second
ldx #80*160+30
jsr DrawString
lda #MODE_NOP
sta MODE
rts
:next1 cmp #5*seconds-20 ;start scroll at 3 second
bne :next2
lda #MODE_SCROLL
sta MODE
rts
:next2 cmp #7*seconds ;draw torii
bne :next3a
lda #MODE_TORUS
sta MODE
rts
:next3a cmp #14*seconds
bne :next3
lda #MODE_NOP
sta MODE
jsr UndrawTorii
rts
:next3 cmp #15*seconds+30 ;second message
bne :next4
lda #Str2 ;draw str1 @ 2 second
ldx #80*160+40
jsr DrawString
rts
:next4 cmp #18*seconds+30 ;scroll off message
bne :next5
lda #MODE_SCROLL
sta MODE
rts
:next5 cmp #20*seconds
bne :next6
lda #Str3
ldx #80*160+24
jsr DrawString
lda #MODE_NOP
sta MODE
rts
:next6 cmp #22*seconds
bne :next7
lda #MODE_SCROLL
sta MODE
rts
:next7 cmp #23*seconds+30 ;draw torii
bne :next8a
lda #MODE_TORUS
sta MODE
rts
:next8a cmp #26*seconds+45
bne :next8
jsr UndrawTorii
lda #MODE_NOP
sta MODE
rts
:next8
cmp #27*seconds
bne :next8scroll
lda #Str4
ldx #80*160+34
jsr DrawString
rts
:next8scroll
cmp #29*seconds
bne :next9
lda #MODE_SCROLL
sta MODE
rts
:next9
cmp #30*seconds+30
bne :next9scroll
lda #Str5
ldx #80*160+14
jsr DrawString
lda #MODE_NOP
sta MODE
rts
:next9scroll
cmp #33*seconds
bne :next10
lda #MODE_SCROLL
sta MODE
rts
:next10
cmp #34*seconds+30
bne :next10scroll
lda #Str6
ldx #80*160+20
jsr DrawString
lda #MODE_NOP
sta MODE
rts
:next10scroll
cmp #36*seconds
bne :next11
lda #MODE_SCROLL
sta MODE
rts
:next11
cmp #37*seconds+30
bne :next11scroll
lda #Str7
ldx #80*160+42
jsr DrawString
lda #MODE_NOP
sta MODE
rts
:next11scroll
cmp #40*seconds
bne :next12
lda #MODE_SCROLL
sta MODE
rts
:next12
cmp #41*seconds+30
bne :next12scroll
lda #Str8
ldx #80*160+52
jsr DrawString
lda #MODE_NOP
sta MODE
rts
:next12scroll
cmp #46*seconds
bne :next13
lda #MODE_SCROLL
sta MODE
rts
:next13
cmp #48*seconds+30
bne :next14
lda #MODE_TORUS
sta MODE
:next14
rts
HandleDemoState
lda MODE
cmp #MODE_NOP
bne :next1
rts
:next1 cmp #MODE_TORUS
bne :next2
jsr UpdateSprite ;does whole torus line. get it? haahah
rts
:next2 cmp #MODE_SCROLL
bne :next3
jsr Scroll
rts
:next3
rts
*--------------------------------------*
* GS/OS File Loading Routines *
*--------------------------------------*
GSOS = $E100A8
LoadFile stx gsosOPEN+4 ; X=File, A=Bank XX/00
sta gsosREAD+5
:openFile jsl GSOS ; Open File
dw $2010
adrl gsosOPEN
bcs :openReadErr
lda gsosOPEN+2
sta gsosGETEOF+2
sta gsosREAD+2
jsl GSOS ; Get File Size
dw $2019
adrl gsosGETEOF
lda gsosGETEOF+4
sta gsosREAD+8
lda gsosGETEOF+6
sta gsosREAD+10
jsl GSOS ; Read File Content
dw $2012
adrl gsosREAD
bcs :openReadErr
:closeFile jsl GSOS ; Close File
dw $2014
adrl gsosCLOSE
clc
lda gsosGETEOF+4 ; File Size
rts
:openReadErr jsr :closeFile
nop
nop
PushWord #0
PushLong #msgLine1
PushLong #msgLine2
PushLong #msgLine3
PushLong #msgLine4
; _TLTextMountVolume
; TODO
pla
cmp #1
bne LF_Err1
brl :openFile
LF_Err1 sec
rts
msgLine1 str 'Unable to load File'
msgLine2 str 'Press a key :'
msgLine3 str ' -> Return to Try Again'
msgLine4 str ' -> Esc to Quit'
*-------
Exit jsl GSOS
dw $2029
adrl gsosQUIT
*-------
gsosOPEN dw 2 ; pCount
ds 2 ; refNum
adrl ImageName ; pathname
gsosGETEOF dw 2 ; pCount
ds 2 ; refNum
ds 4 ; eof
gsosREAD dw 4 ; pCount
ds 2 ; refNum
ds 4 ; dataBuffer
ds 4 ; requestCount
ds 4 ; transferCount
gsosCLOSE dw 1 ; pCount
ds 2 ; refNum
gsosQUIT dw 2 ; pCount
ds 4 ; pathname
ds 2 ; flags
*--------------------------------------*
* Graphics Helpers *
*--------------------------------------*
LoadPicture jsr LoadFile ; X=Nom Image, A=Banc de chargement XX/00
bcc :loadOK
brl Exit
:loadOK jsr UnpackPicture ; A=Packed Size
rts
UnpackPicture sta UP_PackedSize ; Size of Packed Data
lda #$8000 ; Size of output Data Buffer
sta UP_UnPackedSize
lda BankLoad ; Banc de chargement / Decompression
sta UP_Packed+1 ; Packed Data
clc
adc #$0080
stz UP_UnPacked ; On remet a zero car modifie par l'appel
stz UP_UnPacked+2
sta UP_UnPacked+1 ; Unpacked Data buffer
PushWord #0 ; Space for Result : Number of bytes unpacked
PushLong UP_Packed ; Pointer to buffer containing the packed data
PushWord UP_PackedSize ; Size of the Packed Data
PushLong #UP_UnPacked ; Pointer to Pointer to unpacked buffer
PushLong #UP_UnPackedSize ; Pointer to a Word containing size of unpacked data
_UnPackBytes
pla ; Number of byte unpacked
rts
UP_Packed hex 00000000 ; Address of Packed Data
UP_PackedSize hex 0000 ; Size of Packed Data
UP_UnPacked hex 00000000 ; Address of Unpacked Data Buffer (modified)
UP_UnPackedSize hex 0000 ; Size of Unpacked Data Buffer (modified)
*--------------------------------------*
* Misc Graphics Subroutines *
*--------------------------------------*
StartGraphicMode sep #$30
lda #$41 ; Linearise la page graphique
stal $00C029
rep #$30
ldx #$7FFE ; Efface l'Ecran
lda #$0000
SGM_1 stal $E12000,X
dex
dex
bpl SGM_1
sep #$30
lda #$F0 ; Fond Noir
stal $00C022
lda #$00
stal $00C034 ; Bordure Noire
lda #$A1 ; Affiche la page graphique
stal $00C029
lda #$00 ; Active le Shadowing
stal $00C035
rep #$30
rts
*--------------
FadeIn sta FI_00+2 ; A=XX/YY00 de l'image
clc
adc #$007E
sta FI_3+2
sta FI_5+2
sta FI_7+2
ldx #$01FE
lda #$0000 ; NETTOYAGE PREALABLE DES PALETTES en $01/2000
FI_0 stal $019E00,X
dex
dex
bpl FI_0
ldx #$7DFE ; RECOPIE LES POINTS + SCB en $01/2000
FI_00 ldal $000000,X
stal $012000,X
dex
dex
bpl FI_00
ldy #$000F ; ON FAIT UN FADE IN SUR LES 16 PALETTES
FI_1 ldx #$01FE
FI_2 ldal $019E00,X ; COMPOSANTE BLEUE
and #$000F
sta FI_33+1
FI_3 ldal $06FE00,X
and #$000F
FI_33 cmp #$0000
beq FI_4
ldal $019E00,X
clc
adc #$0001
stal $019E00,X
FI_4 ldal $019E00,X ; COMPOSANTE VERTE
and #$00F0
sta FI_55+1
FI_5 ldal $06FE00,X
and #$00F0
FI_55 cmp #$0000
beq FI_6
ldal $019E00,X
clc
adc #$0010
stal $019E00,X
FI_6 ldal $019E00,X ; COMPOSANTE ROUGE
and #$0F00
sta FI_77+1
FI_7 ldal $06FE00,X
and #$0F00
FI_77 cmp #$0000
beq FI_8
ldal $019E00,X
clc
adc #$0100
stal $019E00,X
FI_8 dex
dex
bpl FI_2
jsr WaitForVBL ; TEMPO
jsr WaitForVBL
dey
bpl FI_1
rts
*--------------
FadeOut ldy #$000F ; Fade Out de l'Ecran 01/2000
FO_0 ldx #$01FE
FO_1 ldal $E19E00,X ; COMPOSANTE BLEUE
and #$000F
beq FO_2
ldal $E19E00,X
sec
sbc #$0001
stal $E19E00,X
FO_2 ldal $E19E00,X ; COMPOSANTE VERTE
and #$00F0
beq FO_3
ldal $E19E00,X
sec
sbc #$0010
stal $E19E00,X
FO_3 ldal $E19E00,X ; COMPOSANTE ROUGE
and #$0F00
beq FO_4
ldal $E19E00,X
sec
sbc #$0100
stal $E19E00,X
FO_4 dex
dex
bpl FO_1
dey
jsr WaitForVBL ; TEMPO
jsr WaitForVBL
bpl FO_0
rts
*--------------
WaitForVBL sep #$30 ; Wait fr VBL
:wait1 ldal $00C019
bmi :wait1
:wait2 ldal $00C019
bpl :wait2
rep #$30
rts
*--------------------------------------*
* Misc Subroutines and helpers *
*--------------------------------------*
WaitForKey sep #$30
:wait ldal $00c000
bpl :wait
stal $00c010
rep #$30
rts
MouseClick clc ; BOUTON SOURIS ENFONCE ?
ldal $E0C026
bmi MC_1
rts
MC_1 ldal $E0C023
ldal $E0C023
bpl MC_2
rts
MC_2 sec
rts
*--------------------------------------*
* Memory allocation routines *
*--------------------------------------*
*--------------------------------------*
* AllocOneBank *
* This is a custom allocation function *
* that makes use of the fact that we *
* request an entire locked bank and so *
* simply returns the bank in the *
* accumulator. (basically dereference *
* the Handle to get the pointer) *
*--------------------------------------*
AllocOneBank PushLong #0
PushLong #$10000
PushWord UserId
PushWord #%11000000_00011100
PushLong #0
_NewHandle ; returns LONG Handle on stack
plx ; base address of the new handle
pla ; high address 00XX of the new handle (bank)
xba ; swab accumulator bytes to XX00
sta :bank+2 ; store as bank for next op (overwrite $XX00)
:bank ldal $000001,X ; recover the bank address in A=XX/00
rts
*--------------------------------------*
* Subroutine Includes *
*--------------------------------------*
use TORUS
use FONT
lst on

22
source/font.s → src/font.s
View File

@ -55,27 +55,27 @@ NextChar lda ]F_CharIdx
lda FontData,y
stal $E12000,x
lda FontData+2,y
stal #2+$E12000,x
stal $E12000+2,x
lda FontData+4,y
stal #160+$E12000,x
stal $E12000+#160,x
lda FontData+6,y
stal #160+2+$E12000,x
stal $E12000+#160+2,x
lda FontData+8,y
stal #160*2+$E12000,x
stal $E12000+#320,x
lda FontData+10,y
stal #160*2+2+$E12000,x
stal $E12000+#320+2,x
lda FontData+12,y
stal #160*3+$E12000,x
stal $E12000+#480,x
lda FontData+14,y
stal #160*3+2+$E12000,x
stal $E12000+#480+2,x
lda FontData+16,y
stal #160*4+$E12000,x
stal $E12000+#640,x
lda FontData+18,y
stal #160*4+2+$E12000,x
stal $E12000+#640+2,x
lda FontData+20,y
stal #160*5+$E12000,x
stal $E12000+#800,x
lda FontData+22,y
stal #160*5+2+$E12000,x
stal $E12000+#800+2,x
rts

32
src/gslib.mac.s Normal file
View File

@ -0,0 +1,32 @@
* GSLIB APP HELPER MACROS
* NOISETRACKER MACROS
_NTStartUp MAC
LDX #$02DC
JSL $E10000
<<<
*_NTInitMusic MAC
* <<<
_NTLaunchMusic MAC
LDX #$0ADC
JSL $E10000
<<<
*_NTStartMusic MAC
* <<<
_NTStopMusic MAC
LDX #$0CDC
JSL $E10000
<<<
_NTShutDown MAC
LDX #$03DC
JSL $E10000
<<<

0
source/p8_tools.s → src/p8_tools.s
View File

2
source/quit.s → src/quit.s
View File

@ -5,7 +5,7 @@
* 2013-06-24 *
****************************************
rts ; return from wherever we were called
rts ; return from wherever we were called

27
src/quit16.s Normal file
View File

@ -0,0 +1,27 @@
****************************************
* Quit16 *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-06-10 *
****************************************
rel ; compile as relocatable code
dsk Quit16.sys16 ; Save Name
typ $B3 ; s16
phk ; Set Data Bank to Program Bank
plb ; Always do this first!
jsl $E100A8 ; Prodos 16 entry point
da $29 ; Quit code
adrl QuitParm ; address of parameter table
bcs Error ; never taken
Error brk ; should never get here
QuitParm adrl $0000 ; pointer to pathname (not used here)
da $00 ; quit type (absolute quit)

29
src/quit8.s Normal file
View File

@ -0,0 +1,29 @@
****************************************
* Quit8 *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-06-24 *
****************************************
org $2000 ; start at $2000 (all ProDOS8 system files)
dsk quit8.system ; tell compiler what name for output file
typ $ff ; set P8 type ($ff = "SYS") for output file
MLI equ $bf00
Quit jsr MLI ; first actual command, call ProDOS vector
dfb $65 ; with "quit" request ($65)
da QuitParm
bcs Error
brk $00 ; shouldn't ever here!
QuitParm dfb 4 ; number of parameters
dfb 0 ; standard quit type
da $0000 ; not needed when using standard quit
dfb 0 ; not used
da $0000 ; not used
Error brk $00 ; shouldn't be here either

65
src/shr1.s Normal file
View File

@ -0,0 +1,65 @@
****************************************
* SHR1 *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-17 *
****************************************
rel ; Compile
dsk SHR1.l ; Save Name
typ $B3
mx %00 ; Program starts in 16-bit mode
phk ; Set Data Bank to Program Bank
plb ; Always do this first!
GraphicsOn sep #$30 ; 8-bit mode
lda #$81
stal $00C029 ; Turn on SHR mode
rep #$30 ; back to 16-bit mode
jsr WaitKey ; pause
ClearNaive ldx #$0000 ; Start at first pixel
lda #$0000 ; store zeros
:clearloop stal $E12000,x ; screen location
inx
inx
cpx #$8000 ; see if we've filled entire frame/colors/scbs
bne :clearloop ; pause
jsr WaitKey
ClearFaster ldx #$7FFE ; start at top this time
lda #$0000 ; store zeros
:clearloop stal $E12000,x ; screen location
dex
dex
; avoid 16K "compare X's" for 80K cycle savings
bne :clearloop ; loop until we've worked our way down to 0
jsr WaitKey
jsl $E100A8 ; Prodos 16 entry point
da $29 ; Quit code
adrl QuitParm ; address of parameter table
bcs Error ; never taken
Error brk ; should never get here
QuitParm adrl $0000 ; pointer to pathname (not used here)
da $00 ; quit type (absolute quite)
WaitKey sep #$30 ; good old apple ii key wait routine
:wait ldal $00C000 ; but called using long addressing modes
bpl :wait ; in 8-bit mode
stal $00C010
rep #$30
rts

88
src/shr2.s Normal file
View File

@ -0,0 +1,88 @@
****************************************
* SHR2 *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-17 *
****************************************
rel ;Compile
dsk SHR2.l ;Save Name
typ $B3
mx %00 ;Program starts in 16-bit mode
phk ;Set Data Bank to Program Bank
plb ;Always do this first!
lda #$0FFF ; WHITE color
ldx #$0001 ; palette index 1 (NOT zero)
jsr SetPaletteColor
lda #$0000
jsr SetSCBs ;set all SCBs to 00 (320 mode, pal 0, no fill, no interrupt)
jsr ClearToColor ;clear screen (fill with zeros)
jsr GraphicsOn ;turn on SHR
jsr WaitKey
lda #$1111 ;clear screen to color 1
jsr ClearToColor
jsr WaitKey
jsl $E100A8 ;Prodos 16 entry point
da $29 ;Quit code
adrl QuitParm ;address of parameter table
bcs Error ;never taken
Error brk ;should never get here
QuitParm adrl $0000 ;pointer to pathname (not used here)
da $00 ;quit type (absolute quite)
****************************************
* Turn on SHR mode *
****************************************
GraphicsOn sep #$30 ;8-bit mode
lda #$81 ;%1000 0001
stal $00C029 ;Turn on SHR mode
rep #$30 ;back to 16-bit mode
rts
****************************************
* A= color values (0RGB) *
* X= color/palette offset *
* (0-F = pal0, 10-1F = pal1, etc.) *
****************************************
SetPaletteColor pha ;save accumulator
txa
asl ;X*2 = real offset to color table
tax
pla
stal $E19E00,x ;palettes are stored from $E19E00-FF
rts ;yup, that's it
****************************************
* A= color values (0RGB) *
****************************************
ClearToColor ldx #$7D00 ;start at top of pixel data! ($2000-9D00)
:clearloop dex
dex
stal $E12000,x ;screen location
bne :clearloop ;loop until we've worked our way down to 0
rts
SetSCBs ldx #$0100 ;set all $100 scbs to A
:scbloop dex
dex
stal $E19D00,x
bne :scbloop
rts
WaitKey sep #$30
:wait ldal $00C000
bpl :wait
stal $00C010
rep #$30
rts

100
src/shrhello.s Normal file
View File

@ -0,0 +1,100 @@
****************************************
* SHRHELLO *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-21 *
****************************************
rel ; Compile
dsk SHRHELLO.l ; Save Name
typ $B3
mx %00
phk ; Set Data Bank to Program Bank
plb ; Always do this first!
lda #$0FFF ; WHITE color
ldx #$000F ; palette index 1 (NOT zero)
jsr SetPaletteColor
lda #$0589 ; other color
ldx #$0001 ; palette index 1 (NOT zero)
jsr SetPaletteColor
lda #$0000
jsr SetSCBs ; set all SCBs to 00 (320 mode, pal 0, no fill, no interrupt)
jsr GraphicsOn
lda #$0000 ; clear screen to color 0 and turn on SHR graphics
jsr ClearToColor
lda #HelloStr
ldx #60*160+30
jsr DrawString
jsr WaitKey
lda #$1111 ; clear screen to color 1
jsr ClearToColor
lda #HelloStr
ldx #60*160+30
jsr DrawString
jsr WaitKey
jsl $E100A8 ; Prodos 16 entry point
da $29 ; Quit code
adrl QuitParm ; address of parameter table
bcs Error ; never taken
Error brk ; should never get here
QuitParm adrl $0000 ; pointer to pathname (not used here)
da $00 ; quit type (absolute quite)
HelloStr str 'HELLO KANSASFEST'
****************************************
* Turn on SHR mode *
****************************************
GraphicsOn sep #$30 ;8-bit mode
lda #$81 ;%1000 0001
stal $00C029 ;Turn on SHR mode
rep #$30 ;back to 16-bit mode
rts
****************************************
* A= color values (0RGB) *
* X= color/palette offset *
* (0-F = pal0, 10-1F = pal1, etc.) *
****************************************
SetPaletteColor pha ;save accumulator
txa
asl ;X*2 = real offset to color table
tax
pla
stal $E19E00,x ;palettes are stored from $E19E00-FF
rts ;yup, that's it
****************************************
* A= color values (0RGB) *
****************************************
ClearToColor ldx #$7D00 ;start at top of pixel data! ($2000-9D00)
:clearloop dex
dex
stal $E12000,x ;screen location
bne :clearloop ;loop until we've worked our way down to 0
rts
SetSCBs ldx #$0100 ;set all $100 scbs to A
:scbloop dex
dex
stal $E19D00,x
bne :scbloop
rts
WaitKey sep #$30
:wait ldal $00c000
bpl :wait
stal $00c010
rep #$30
rts
use FONT ;include our font library

0
source/shrloadimg.m.s → src/shrloadimg.m.s
View File

267
src/shrloadimg.s Normal file
View File

@ -0,0 +1,267 @@
****************************************
* SHRLOADIMG *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-21 *
****************************************
rel ; Compile
dsk SHRLOADIMG.l ; Save Name
typ $B3
use shrloadimg.m
mx %00 ; Program starts in 16-bit mode
****************************************
* Basic Error Macro *
****************************************
_Err mac
bcc NoErr
do ]0 ; (DO if true)
jsr PgmDeath ; this is conditionally compiled if
str ]1 ; we pass in an error statement
else ; (ELSE)
jmp PgmDeath0 ; we just call the simpler error handler
fin ; (FIN)
NoErr eom
****************************************
* Program Start *
****************************************
phk ; Set Data Bank to Program Bank
plb ; Always do this first!
****************************************
* Typical tool startup *
****************************************
_TLStartUp ; normal tool initialization
pha
_MMStartUp
_Err ; should never happen
pla
sta MasterId ; our master handle references the memory allocated to us
ora #$0100 ; set auxID = $01 (valid values $01-0f)
sta UserId ; any memory we request must use our own id
****************************************
* Initialize graphics *
****************************************
jsr AllocOneBank ; Alloc 64KB for Load/Unpack
sta BankLoad ; Store "Bank Pointer"
ldx #ImageName ; Load+Unpack Boot Picture
jsr LoadPicture ; X=Name, A=Bank to use for loading
lda BankLoad ; get address of loaded/uncompressed picture
clc
adc #$0080 ; skip header?
sta :copySHR+2 ; and store that over the 'ldal' address below
ldx #$7FFE ; copy all image data
:copySHR ldal $000000,x ; load from BankLoad we allocated
stal $E12000,x ; store to SHR screen
dex
dex
bpl :copySHR
jsr GraphicsOn
jsr WaitKey
bra Quit
ImageName strl '1/KFEST2013.PAK'
MasterId ds 2
UserId ds 2
BankLoad hex 0000 ; used for Load/Unpack
Quit jsl $E100A8 ; Prodos 16 entry point
da $29 ; Quit code
adrl QuitParm ; address of parameter table
bcs Error ; never taken
Error brk ; should never get here
QuitParm adrl $0000 ; pointer to pathname (not used here)
da $00 ; quit type (absolute quite)
****************************************
* AllocOneBank *
* This is a custom allocation function *
* that makes use of the fact that we *
* request an entire locked bank and so *
* simply returns the bank in the *
* accumulator. (basically dereference *
* the Handle to get the pointer) *
****************************************
AllocOneBank PushLong #0
PushLong #$10000
PushWord UserId
PushWord #%11000000_00011100
PushLong #0
_NewHandle ; returns LONG Handle on stack
plx ; base address of the new handle
pla ; high address 00XX of the new handle (bank)
xba ; swap accumulator bytes to XX00
sta :bank+2 ; store as bank for next op (overwrite $XX00)
:bank ldal $000001,X ; recover the bank address in A=XX/00
rts
****************************************
* Graphics Helpers *
****************************************
LoadPicture jsr LoadFile ; X=Nom Image, A=Banc de chargement XX/00
bcc :loadOK
brl Exit
:loadOK jsr UnpackPicture ; A=Packed Size
rts
UnpackPicture sta UP_PackedSize ; Size of Packed Data
lda #$8000 ; Size of output Data Buffer
sta UP_UnPackedSize
lda BankLoad ; Banc de chargement / Decompression
sta UP_Packed+1 ; Packed Data
clc
adc #$0080
stz UP_UnPacked ; On remet a zero car modifie par l'appel
stz UP_UnPacked+2
sta UP_UnPacked+1 ; Unpacked Data buffer
PushWord #0 ; Space for Result : Number of bytes unpacked
PushLong UP_Packed ; Pointer to buffer containing the packed data
PushWord UP_PackedSize ; Size of the Packed Data
PushLong #UP_UnPacked ; Pointer to Pointer to unpacked buffer
PushLong #UP_UnPackedSize ; Pointer to a Word containing size of unpacked data
_UnPackBytes
pla ; Number of byte unpacked
rts
UP_Packed hex 00000000 ; Address of Packed Data
UP_PackedSize hex 0000 ; Size of Packed Data
UP_UnPacked hex 00000000 ; Address of Unpacked Data Buffer (modified)
UP_UnPackedSize hex 0000 ; Size of Unpacked Data Buffer (modified)
****************************************
* Turn on SHR mode *
****************************************
GraphicsOn sep #$30 ; 8-bit mode
lda #$C1
stal $00C029 ; Turn on SHR mode
rep #$30 ; back to 16-bit mode
rts
WaitKey sep #$30
:wait ldal $00C000
bpl :wait
stal $00C010
rep #$30
rts
****************************************
* Fatal Error Handler *
****************************************
PgmDeath tax
pla
inc
phx
phk
pha
bra ContDeath
PgmDeath0 pha
pea $0000
pea $0000
ContDeath ldx #$1503
jsl $E10000
****************************************
* Normal GSOS Quit *
****************************************
Exit jsl GSOS
dw $2029
adrl QuitGS
****************************************
* GS/OS / ProDOS 16 File Routines *
****************************************
GSOS = $E100A8
LoadFile stx OpenGS+4 ; X=File, A=Bank/Page XX/00
sta ReadGS+5
:openFile jsl GSOS ; Open File
dw $2010
adrl OpenGS
bcs :openReadErr
lda OpenGS+2
sta GetEOFGS+2
sta ReadGS+2
jsl GSOS ; Get File Size
dw $2019
adrl GetEOFGS
lda GetEOFGS+4
sta ReadGS+8
lda GetEOFGS+6
sta ReadGS+10
jsl GSOS ; Read File Content
dw $2012
adrl ReadGS
bcs :openReadErr
:closeFile jsl GSOS ; Close File
dw $2014
adrl CloseGS
clc
lda GetEOFGS+4 ; File Size
rts
:openReadErr jsr :closeFile
nop
nop
PushWord #0
PushLong #msgLine1
PushLong #msgLine2
PushLong #msgLine3
PushLong #msgLine4
_TLTextMountVol ; actualname is TLTextMountVolume
pla
cmp #1
bne :loadFileErr
brl :openFile
:loadFileErr sec
rts
msgLine1 str 'Unable to load File'
msgLine2 str 'Press a key :'
msgLine3 str ' -> Return to Try Again'
msgLine4 str ' -> Esc to Quit'
OpenGS dw 2 ; pCount
ds 2 ; refNum
adrl ImageName ; pathname
GetEOFGS dw 2 ; pCount
ds 2 ; refNum
ds 4 ; eof
ReadGS dw 4 ; pCount
ds 2 ; refNum
ds 4 ; dataBuffer
ds 4 ; requestCount
ds 4 ; transferCount
CloseGS dw 1 ; pCount
ds 2 ; refNum
QuitGS dw 2 ; pCount
ds 4 ; pathname
ds 2 ; flags

39
src/skel.macgen.s Normal file
View File

@ -0,0 +1,39 @@
_TLStartUp MAC
Tool $201
<<<
_MMStartUp MAC
Tool $202
<<<
_MMShutDown MAC
Tool $302
<<<
_NewHandle MAC
Tool $902
<<<
_UnPackBytes MAC
Tool $2703
<<<
PushLong MAC
IF #=]1
PushWord #^]1
ELSE
PushWord ]1+2
FIN
PushWord ]1
<<<
PushWord MAC
IF #=]1
PEA ]1
ELSE
IF MX/2
LDA ]1+1
PHA
FIN
LDA ]1
PHA
FIN
<<<
Tool MAC
LDX #]1
JSL $E10000
<<<

29
src/torus.s Normal file
View File

@ -0,0 +1,29 @@
Drawtorus ASL ; A=Sprite Number ($0000-$003C)
TAX ; Y=Target Screen Address ($2000-$9D00)
LDA torusNum,X ; Relative Sprite Number Table
JMP (torusBank,X) ; Bank Number Table
torusNum HEX 1600,1400,0E00,1300,0400,0100,0600,1200
HEX 0200,0F00,0800,1800,1700,1F00,1E00,2200
HEX 2700,2600,3000,2D00,3600,3500,3C00,3700
HEX 3100,2F00,2800,2300,2000,1500,1000,0700
HEX 0C00,0D00,0300,0000,0500,0B00,0A00,0900
HEX 1100,1A00,1900,1B00,1D00,2100,2A00,2400
HEX 2900,2C00,2E00,3300,3900,3B00,3800,3400
HEX 3200,2B00,2500,1C00,3A00
torusBank DA torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00
DA torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00
DA torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00
DA torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00
DA torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00
DA torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00
DA torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00,torusBank00
DA torusBank00,torusBank00,torusBank00,torusBank00,torusBank00
torusBank00 JSL $AA0000
PHK
PLB
RTS
*------------------------------------------------