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

new CI + indent

This commit is contained in:
Dagen Brock 2023-04-11 20:01:46 -05:00
parent 308584bd59
commit 24329093d4
24 changed files with 674 additions and 626 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
.github/workflows/assemble_and_publish_release.yml vendored Normal file
View File

@ -0,0 +1,47 @@
name: GSLib CI (Appy Project - 65xxx Assemble+Package)
on:
pull_request:
push:
jobs:
appy-ci:
runs-on: ubuntu-latest
steps:
- name: Checkout
uses: actions/checkout@v3
with:
fetch-depth: 0
# This will install Appy plus Merlin32 and Cadius on your Github Runner machine
- name: Install Appy
uses: digarok/install-appy-pack-action@main
with:
include_prodos: true
# appy_version: v0.1.7
# Now you can use it to assemble your project(s)
- name: Assemble
run: |
appy asm
# This could be one step but I like to see the disk image separately in github UI
- name: Create Disk Image
run: |
appy disk
- name: Create Release
id: create_release
if: startsWith(github.ref, 'refs/tags/v')
uses: actions/create-release@v1
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
with:
tag_name: ${{ github.ref }}
release_name: Release ${{ github.ref }}
- name: Upload Release Asset - 800KB ProDOS Image
if: startsWith(github.ref, 'refs/tags/v')
uses: actions/upload-release-asset@v1.0.1
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
with:
upload_url: ${{ steps.create_release.outputs.upload_url }}
asset_path: ./demodisk800.2mg
asset_name: demodisk800.2mg
asset_content_type: application/octet-stream

6
.gitignore vendored Normal file
View File

@ -0,0 +1,6 @@
*_Output.txt
*.Sys16
*.S16
*.system
*.2mg
_FileInformation.txt

3
README.md
View File

@ -16,6 +16,3 @@ 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

64
appy.yaml
View File

@ -1,39 +1,33 @@
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
- source/quit.s
- source/quit8.s
- source/quit16.s
- source/shr1.s
- source/shr2.s
- source/shrhello.s
- source/shrloadimg.s
assembleflags: "-V"
# formatflags: "mc:10 oc:14 cc:30 ms:1 bs:2"
# additional files to indent along with above
indent:
- source/shrloadimg.m.s
disks:
- name: gslib
file: gslib.2mg
- name: gslibdemo
file: gslibdemo800.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
files:
- input: source/quit
output: /gslibdemo
- input: source/quit8.system
output: /gslibdemo
- input: source/Quit.Sys16
output: /gslibdemo
- input: source/SHR1.Sys16
output: /gslibdemo
- input: source/SHR2.Sys16
output: /gslibdemo
- input: source/SHRHello.Sys16
output: /gslibdemo
- input: source/SHRLoadImage.S16
output: /gslibdemo
- input: content/KFEST2013B.PAK
output: /gslib
- input: content/torus00.bin
output: /gslib
- input: content/song3.nt
output: /gslib

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

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

@ -4,6 +4,11 @@
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-20 *
****************************************
* Note that this is not particularly *
* optimized. But it's meant to be a *
* straightforward implementation that *
* is easy to understand. *
****************************************
* A= ptr to string preceded by length *
* X= screen location *
****************************************
@ -55,27 +60,27 @@ NextChar lda ]F_CharIdx
lda FontData,y
stal $E12000,x
lda FontData+2,y
stal $E12000+2,x
stal #2+$E12000,x
lda FontData+4,y
stal $E12000+#160,x
stal #160+$E12000,x
lda FontData+6,y
stal $E12000+#160+2,x
stal #160+2+$E12000,x
lda FontData+8,y
stal $E12000+#320,x
stal #160*2+$E12000,x
lda FontData+10,y
stal $E12000+#320+2,x
stal #160*2+2+$E12000,x
lda FontData+12,y
stal $E12000+#480,x
stal #160*3+$E12000,x
lda FontData+14,y
stal $E12000+#480+2,x
stal #160*3+2+$E12000,x
lda FontData+16,y
stal $E12000+#640,x
stal #160*4+$E12000,x
lda FontData+18,y
stal $E12000+#640+2,x
stal #160*4+2+$E12000,x
lda FontData+20,y
stal $E12000+#800,x
stal #160*5+$E12000,x
lda FontData+22,y
stal $E12000+#800+2,x
stal #160*5+2+$E12000,x
rts

0
src/gslib.mac.s → source/gslib.mac.s
View File

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

2
src/quit.s → source/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
source/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 Quit.Sys16 ; Save Name
typ $B3 ; S16, GS/OS Application
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 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

64
source/shr1.s Normal file
View File

@ -0,0 +1,64 @@
****************************************
* SHR1 *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-17 *
****************************************
rel ; Compile
dsk SHR1.Sys16 ; Save Name
typ $B3 ; S16, GS/OS Application
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
source/shr2.s Normal file
View File

@ -0,0 +1,88 @@
****************************************
* SHR2 *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-17 *
****************************************
rel ;Compile
dsk SHR2.Sys16 ;Save Name
typ $B3 ; S16, GS/OS Application
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
source/shrhello.s Normal file
View File

@ -0,0 +1,100 @@
****************************************
* SHRHELLO *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-21 *
****************************************
rel ; Compile
dsk SHRHello.Sys16 ; Save Name
typ $B3 ; S16, GS/OS Application
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
src/shrloadimg.m.s → source/shrloadimg.m.s
View File

267
source/shrloadimg.s Normal file
View File

@ -0,0 +1,267 @@
****************************************
* SHRLOADIMG *
* *
* Dagen Brock <dagenbrock@gmail.com> *
* 2013-07-21 *
****************************************
rel ; Compile
dsk SHRLoadImg.S16 ; Save Name
typ $B3 ; S16, GS/OS Application
use shrloadimg.m ; include macros from another
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

0
src/skel.macgen.s → source/skel.macgen.s
View File

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

27
src/quit16.s
View File

@ -1,27 +0,0 @@
****************************************
* 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
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

65
src/shr1.s
View File

@ -1,65 +0,0 @@
****************************************
* 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
View File

@ -1,88 +0,0 @@
****************************************
* 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
View File

@ -1,100 +0,0 @@
****************************************
* 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

267
src/shrloadimg.s
View File

@ -1,267 +0,0 @@
****************************************
* 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