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_Pack