mirror of
https://github.com/irmen/prog8.git
synced 2026-04-20 11:17:01 +00:00
add Amiga boing ball example, plus more pet syslib definitions, and pet diskio beginnings
This commit is contained in:
Irmen de Jong
@@ -0,0 +1,78 @@
|
||||
%import strings
|
||||
%import syslib
|
||||
|
||||
diskio {
|
||||
%option no_symbol_prefixing, ignore_unused
|
||||
|
||||
const ubyte READ_IO_CHANNEL=12
|
||||
const ubyte WRITE_IO_CHANNEL=13
|
||||
const ubyte STATUS_EOF=$40
|
||||
|
||||
ubyte @shared drivenumber = 8 ; user programs can set this to the drive number they want to load/save to!
|
||||
|
||||
str list_filename = "?" * 50
|
||||
|
||||
sub reset_read_channel() {
|
||||
void cbm.CHKIN(READ_IO_CHANNEL)
|
||||
}
|
||||
|
||||
sub reset_write_channel() {
|
||||
cbm.CHKOUT(WRITE_IO_CHANNEL)
|
||||
}
|
||||
|
||||
sub status() -> str {
|
||||
; -- retrieve the disk drive's current status message
|
||||
|
||||
^^ubyte messageptr = &list_filename
|
||||
cbm.SETNAM(0, list_filename)
|
||||
cbm.SETLFS(15, drivenumber, 15)
|
||||
void cbm.OPEN() ; open 15,8,15
|
||||
void cbm.CHKIN(15) ; use #15 as input channel
|
||||
|
||||
while cbm.READST()==0 {
|
||||
cx16.r5L = cbm.CHRIN()
|
||||
if cx16.r5L=='\r' or cx16.r5L=='\n'
|
||||
break
|
||||
@(messageptr) = cx16.r5L
|
||||
messageptr++
|
||||
}
|
||||
@(messageptr) = 0
|
||||
|
||||
done:
|
||||
cbm.CLOSE(15)
|
||||
cbm.CLRCHN() ; restore default i/o devices
|
||||
return list_filename
|
||||
}
|
||||
|
||||
; similar to above, but instead of fetching the entire string, it only fetches the status code and returns it as ubyte
|
||||
; in case of IO error, returns 255 (CMDR-DOS itself is physically unable to return such a value)
|
||||
sub status_code() -> ubyte {
|
||||
if cbm.READST()==128 {
|
||||
return 255
|
||||
}
|
||||
|
||||
cbm.SETNAM(0, list_filename)
|
||||
cbm.SETLFS(15, drivenumber, 15)
|
||||
void cbm.OPEN() ; open 15,8,15
|
||||
if_cs
|
||||
goto io_error
|
||||
void cbm.CHKIN(15) ; use #15 as input channel
|
||||
|
||||
list_filename[0] = cbm.CHRIN()
|
||||
list_filename[1] = cbm.CHRIN()
|
||||
list_filename[2] = 0
|
||||
|
||||
while cbm.READST()==0 {
|
||||
void cbm.CHRIN()
|
||||
}
|
||||
|
||||
cbm.CLRCHN() ; restore default i/o devices
|
||||
cbm.CLOSE(15)
|
||||
return conv.str2ubyte(list_filename)
|
||||
|
||||
io_error:
|
||||
cbm.CLRCHN()
|
||||
cbm.CLOSE(15)
|
||||
return 255
|
||||
}
|
||||
}
|
||||
@@ -24,18 +24,19 @@ const uword FAC_ADDR = $5e
|
||||
;extsub $b7b5 = FREADSTR(ubyte length @ A) clobbers(A,X,Y) ; str -> fac1, $22/23 must point to string, A=string length. Also see parse()
|
||||
;extsub $aabc = FPRINTLN() clobbers(A,X,Y) ; print string of fac1, on one line (= with newline) destroys fac1. (consider FOUT + STROUT as well)
|
||||
;
|
||||
;extsub $bc5b = FCOMP(uword mflpt @ AY) clobbers(X,Y) -> ubyte @ A ; A = compare fac1 to mflpt in A/Y, 0=equal 1=fac1 is greater, 255=fac1 is less than
|
||||
;
|
||||
;extsub $bf7b = FPWRT() clobbers(A,X,Y) ; fac1 = fac2 ** fac1
|
||||
;extsub $bf78 = FPWR(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 = fac2 ** mflpt from A/Y
|
||||
;extsub $bd7e = FINLOG(byte value @A) clobbers (A, X, Y) ; fac1 += signed byte in A
|
||||
;
|
||||
;extsub $aed4 = NOTOP() clobbers(A,X,Y) ; fac1 = NOT(fac1)
|
||||
;extsub $bc39 = SGN() clobbers(A,X,Y) ; fac1 = SGN(fac1), result of SIGN (-1, 0 or 1)
|
||||
;extsub $bf74 = SQRA() clobbers(A,X,Y) ; fac1 = SQRT(fac2)
|
||||
|
||||
|
||||
; PET32 BASIC 4.0 ADDRESSES FOUND:
|
||||
; (source: https://www.zimmers.net/cbmpics/cbm/PETx/petmem.txt )
|
||||
|
||||
; TODO need FREADSA, correct implementation for GIVUAYFAY
|
||||
|
||||
|
||||
;; fac1 -> unsigned word in Y/A (might throw ILLEGAL QUANTITY) (result also in $14/15)
|
||||
;; (tip: use floats.GETADRAY to get A/Y output; lo/hi switched to normal little endian order)
|
||||
@@ -68,16 +69,19 @@ extsub $c99d = FADD(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 += mflpt valu
|
||||
extsub $c97f = FADDH() clobbers(A,X,Y) ; fac1 += 0.5, for integer rounding- call this before INT
|
||||
extsub $c989 = FSUBT() clobbers(A,X,Y) ; fac1 = fac2-fac1 mind the order of the operands
|
||||
extsub $c986 = FSUB(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 = mflpt from A/Y - fac1
|
||||
extsub $cd91 = FCOMP(uword mflpt @ AY) clobbers(X,Y) -> ubyte @ A ; A = compare fac1 to mflpt in A/Y, 0=equal 1=fac1 is greater, 255=fac1 is less than
|
||||
extsub $d112 = FPWRT() clobbers(A,X,Y) ; fac1 = fac2 ** fac1
|
||||
|
||||
|
||||
extsub $ca0d = NORMAL() clobbers(A) ; normalize FAC1
|
||||
extsub $cd61 = SIGN() -> ubyte @ A ; SIGN(fac1) to A, $ff, $0, $1 for negative, zero, positive
|
||||
extsub $cd6f = SGN() clobbers(A,X,Y) ; fac1 = SGN(fac1), result of SIGN (-1, 0 or 1)
|
||||
extsub $cd8e = ABS() ; fac1 = ABS(fac1)
|
||||
extsub $cdd1 = QINT() clobbers(A,X,Y) ; fac1 -> 4-byte signed integer in FAC, with the MSB FIRST.
|
||||
extsub $ce02 = INT() clobbers(A,X,Y) ; INT() truncates, use FADDH first to integer round instead of trunc
|
||||
extsub $cf93 = FOUT() clobbers(X) -> uword @ AY ; fac1 -> string, address returned in AY
|
||||
|
||||
extsub $d108 = SQR() clobbers(A,X,Y) ; fac1 = SQRT(fac1) TODO is this address correct?
|
||||
extsub $d108 = SQR() clobbers(A,X,Y) ; fac1 = SQRT(fac1)
|
||||
extsub $d14b = NEGOP() clobbers(A) ; switch the sign of fac1 (fac1 = -fac1)
|
||||
extsub $d184 = EXP() clobbers(A,X,Y) ; fac1 = EXP(fac1) (e ** fac1)
|
||||
extsub $d229 = RND() clobbers(A,X,Y) ; fac1 = RND(fac1) float random number generator
|
||||
@@ -121,6 +125,15 @@ asmsub GIVAYFAY (uword value @ AY) clobbers(A,X,Y) {
|
||||
}}
|
||||
}
|
||||
|
||||
asmsub GIVUAYFAY (uword value @ AY) clobbers(A,X,Y) {
|
||||
; ---- unsigned 16 bit word in A/Y (lo/hi) to fac1
|
||||
%asm {{
|
||||
; TODO does PET have FLOATC? does it have basic internal routine like the C64 version of this has?
|
||||
brk
|
||||
rts
|
||||
}}
|
||||
}
|
||||
|
||||
%asminclude "library:c64/floats.asm"
|
||||
%asminclude "library:c64/floats_funcs.asm"
|
||||
|
||||
|
||||
@@ -11,6 +11,13 @@ cbm {
|
||||
&ubyte TIME_MID = $8e ; .. mid byte
|
||||
&ubyte TIME_LO = $8f ; .. lo byte. Updated by IRQ every 1/60 sec
|
||||
&ubyte STATUS = $96 ; kernal status variable for I/O
|
||||
&ubyte FNLEN = $D1 ; Length of filename
|
||||
&ubyte LFN = $D2 ; Current Logical File Number
|
||||
&ubyte SECADR = $D3 ; Secondary address
|
||||
&ubyte DEVNUM = $D4 ; Device number
|
||||
&ubyte CURS_X = $C6 ; Cursor column
|
||||
&ubyte CURS_Y = $D8 ; Cursor row
|
||||
&ubyte FNADR = $DA ; Pointer to file name
|
||||
|
||||
&uword CINV = $0090 ; IRQ vector (in ram)
|
||||
&uword CBINV = $0092 ; BRK vector (in ram)
|
||||
@@ -35,6 +42,37 @@ extsub $FFE7 = CLALL() clobbers(A,X) ; close all file
|
||||
extsub $FFEA = UDTIM() clobbers(A,X) ; update the software clock
|
||||
|
||||
|
||||
extsub $F563 = OPEN() clobbers(X,Y) -> bool @Pc, ubyte @A ; open a logical file
|
||||
extsub $F2E2 = CLOSE(ubyte logical @ A) clobbers(A,X,Y) ; close a logical file
|
||||
|
||||
asmsub READST() -> ubyte @ A {
|
||||
; read io status
|
||||
%asm {{
|
||||
lda STATUS
|
||||
rts
|
||||
}}
|
||||
}
|
||||
|
||||
asmsub SETLFS(ubyte logical @ A, ubyte device @ X, ubyte secondary @ Y) {
|
||||
; set logical file parameters
|
||||
%asm {{
|
||||
sta LFN ; LFN
|
||||
stx DEVNUM ; Device address
|
||||
sty SECADR ; Secondary address
|
||||
rts
|
||||
}}
|
||||
}
|
||||
|
||||
asmsub SETNAM(ubyte namelen @ A, str filename @ XY) {
|
||||
; set filename parameters
|
||||
%asm {{
|
||||
sta FNLEN
|
||||
stx FNADR
|
||||
sty FNADR+1
|
||||
rts
|
||||
}}
|
||||
}
|
||||
|
||||
inline asmsub STOP2() clobbers(X,A) -> bool @Pz {
|
||||
; -- just like STOP, but omits the special keys result value in A.
|
||||
; just for convenience because most of the times you're only interested in the stop pressed or not status.
|
||||
@@ -137,6 +175,28 @@ pet {
|
||||
&ubyte via1ifr = VIA1_BASE + 13
|
||||
&ubyte via1ier = VIA1_BASE + 14
|
||||
&ubyte via1ora = VIA1_BASE + 15
|
||||
|
||||
extsub $ff93 = concat() clobbers (A,X,Y)
|
||||
extsub $ff96 = dopen() clobbers (A,X,Y)
|
||||
extsub $ff99 = dclose() clobbers (A,X,Y)
|
||||
extsub $ff9c = record() clobbers (A,X,Y)
|
||||
extsub $ff9f = header() clobbers (A,X,Y)
|
||||
extsub $ffa2 = collect() clobbers (A,X,Y)
|
||||
extsub $ffa5 = backup() clobbers (A,X,Y)
|
||||
extsub $ffa8 = copy() clobbers (A,X,Y)
|
||||
extsub $ffab = append() clobbers (A,X,Y)
|
||||
extsub $ffae = dsave() clobbers (A,X,Y)
|
||||
extsub $ffb1 = dload() clobbers (A,X,Y)
|
||||
extsub $ffb4 = catalog() clobbers (A,X,Y)
|
||||
extsub $ffb7 = rename() clobbers (A,X,Y)
|
||||
extsub $ffba = scratch() clobbers (A,X,Y)
|
||||
extsub $ffc0 = open() clobbers (A,X,Y)
|
||||
extsub $ffc3 = close() clobbers (A,X,Y)
|
||||
extsub $ffd5 = load() clobbers (A,X,Y)
|
||||
extsub $ffd8 = save() clobbers (A,X,Y)
|
||||
extsub $ffdb = verify() clobbers (A,X,Y)
|
||||
extsub $ffde = sys() clobbers (A,X,Y)
|
||||
|
||||
}
|
||||
|
||||
%import shared_sys_functions
|
||||
|
||||
@@ -204,6 +204,7 @@ class TestCompilerOnExamplesBothC64andCx16: FunSpec({
|
||||
val bothCx16AndC64 = cartesianProduct(
|
||||
listOf(
|
||||
"balls",
|
||||
"boingball",
|
||||
"cube3d",
|
||||
"cube3d-float",
|
||||
"cube3d-gfx",
|
||||
|
||||
@@ -6,6 +6,7 @@
|
||||
%import conv
|
||||
%import coroutines
|
||||
%import cx16logo
|
||||
%import diskio
|
||||
%import floats
|
||||
%import math
|
||||
%import petsnd
|
||||
|
||||
@@ -168,6 +168,22 @@ cx16logo {
|
||||
}
|
||||
|
||||
|
||||
LIBRARY MODULE NAME: diskio
|
||||
---------------------------
|
||||
|
||||
diskio {
|
||||
const ubyte READ_IO_CHANNEL
|
||||
const ubyte STATUS_EOF
|
||||
const ubyte WRITE_IO_CHANNEL
|
||||
ubyte @shared drivenumber
|
||||
str list_filename
|
||||
reset_read_channel ()
|
||||
reset_write_channel ()
|
||||
status () -> str
|
||||
status_code () -> ubyte
|
||||
}
|
||||
|
||||
|
||||
LIBRARY MODULE NAME: floats
|
||||
---------------------------
|
||||
|
||||
@@ -189,17 +205,20 @@ floats {
|
||||
FADD (uword mflpt @AY) clobbers (A,X,Y) = $c99d
|
||||
FADDH () clobbers (A,X,Y) = $c97f
|
||||
FADDT () clobbers (A,X,Y) = $c9a0
|
||||
FCOMP (uword mflpt @AY) clobbers (X,Y) -> ubyte @A = $cd91
|
||||
FDIV (uword mflpt @AY) clobbers (A,X,Y) = $cc45
|
||||
FDIVT () clobbers (A,X,Y) = $cc48
|
||||
FMULT (uword mflpt @AY) clobbers (A,X,Y) = $cb5e
|
||||
FMULTT () clobbers (A,X,Y) = $cb61
|
||||
FOUT () clobbers (X) -> uword @AY = $cf93
|
||||
FPWRT () clobbers (A,X,Y) = $d112
|
||||
FSUB (uword mflpt @AY) clobbers (A,X,Y) = $c986
|
||||
FSUBT () clobbers (A,X,Y) = $c989
|
||||
GETADR () clobbers (X) -> ubyte @Y, ubyte @A = $c92d
|
||||
GETADRAY () clobbers (X) -> uword @AY
|
||||
GIVAYF (ubyte lo @Y, ubyte hi @A) clobbers (A,X,Y) = $c4bc
|
||||
GIVAYFAY (uword value @AY) clobbers (A,X,Y)
|
||||
GIVUAYFAY (uword value @AY) clobbers (A,X,Y)
|
||||
INT () clobbers (A,X,Y) = $ce02
|
||||
LOG () clobbers (A,X,Y) = $cb20
|
||||
MOVAF () clobbers (A,X) = $cd42
|
||||
@@ -212,6 +231,7 @@ floats {
|
||||
NORMAL () clobbers (A) = $ca0d
|
||||
QINT () clobbers (A,X,Y) = $cdd1
|
||||
RND () clobbers (A,X,Y) = $d229
|
||||
SGN () clobbers (A,X,Y) = $cd6f
|
||||
SIGN () -> ubyte @A = $cd61
|
||||
SIN () clobbers (A,X,Y) = $d289
|
||||
SQR () clobbers (A,X,Y) = $d108
|
||||
@@ -414,10 +434,17 @@ LIBRARY MODULE NAME: syslib
|
||||
cbm {
|
||||
&uword CBINV
|
||||
&uword CINV
|
||||
&ubyte CURS_X
|
||||
&ubyte CURS_Y
|
||||
&ubyte DEVNUM
|
||||
&ubyte FNADR
|
||||
&ubyte FNLEN
|
||||
&uword IRQ_VEC
|
||||
&ubyte LFN
|
||||
&uword NMINV
|
||||
&uword NMI_VEC
|
||||
&uword RESET_VEC
|
||||
&ubyte SECADR
|
||||
&ubyte STATUS
|
||||
const uword Screen
|
||||
&ubyte TIME_HI
|
||||
@@ -428,12 +455,17 @@ cbm {
|
||||
CHRIN () clobbers (X,Y) -> ubyte @A = $ffcf
|
||||
CHROUT (ubyte character @A) = $ffd2
|
||||
CLALL () clobbers (A,X) = $ffe7
|
||||
CLOSE (ubyte logical @A) clobbers (A,X,Y) = $f2e2
|
||||
CLRCHN () clobbers (A,X) = $ffcc
|
||||
GETIN () clobbers (X,Y) -> bool @Pc, ubyte @A = $ffe4
|
||||
GETIN2 () clobbers (X,Y) -> ubyte @A
|
||||
OPEN () clobbers (X,Y) -> bool @Pc, ubyte @A = $f563
|
||||
RDTIM () -> ubyte @A, ubyte @X, ubyte @Y
|
||||
RDTIM16 () clobbers (X) -> uword @AY
|
||||
RDTIML () clobbers (X) -> long @R0R1
|
||||
READST () -> ubyte @A
|
||||
SETLFS (ubyte logical @A, ubyte device @X, ubyte secondary @Y)
|
||||
SETNAM (ubyte namelen @A, str filename @XY)
|
||||
SETTIM (ubyte low @A, ubyte middle @X, ubyte high @Y)
|
||||
SETTIML (long jiffies @R0R1)
|
||||
STOP () clobbers (X) -> bool @Pz, ubyte @A = $ffe1
|
||||
@@ -463,6 +495,26 @@ pet {
|
||||
&uword via1t2
|
||||
&ubyte via1t2h
|
||||
&ubyte via1t2l
|
||||
append () clobbers (A,X,Y) = $ffab
|
||||
backup () clobbers (A,X,Y) = $ffa5
|
||||
catalog () clobbers (A,X,Y) = $ffb4
|
||||
close () clobbers (A,X,Y) = $ffc3
|
||||
collect () clobbers (A,X,Y) = $ffa2
|
||||
concat () clobbers (A,X,Y) = $ff93
|
||||
copy () clobbers (A,X,Y) = $ffa8
|
||||
dclose () clobbers (A,X,Y) = $ff99
|
||||
dload () clobbers (A,X,Y) = $ffb1
|
||||
dopen () clobbers (A,X,Y) = $ff96
|
||||
dsave () clobbers (A,X,Y) = $ffae
|
||||
header () clobbers (A,X,Y) = $ff9f
|
||||
load () clobbers (A,X,Y) = $ffd5
|
||||
open () clobbers (A,X,Y) = $ffc0
|
||||
record () clobbers (A,X,Y) = $ff9c
|
||||
rename () clobbers (A,X,Y) = $ffb7
|
||||
save () clobbers (A,X,Y) = $ffd8
|
||||
scratch () clobbers (A,X,Y) = $ffba
|
||||
sys () clobbers (A,X,Y) = $ffde
|
||||
verify () clobbers (A,X,Y) = $ffdb
|
||||
}
|
||||
|
||||
sys {
|
||||
|
||||
@@ -105,7 +105,8 @@ IR/VM
|
||||
Libraries
|
||||
---------
|
||||
- Add split-word array sorting routines to sorting module?
|
||||
- pet32 target: make syslib more complete (missing kernal routines)?
|
||||
- pet32: make syslib more complete (missing kernal routines)?
|
||||
- pet32: still missing floats.FREADSA and floats.GIVUAYFAY (and some others)
|
||||
- need help with: PET disk routines (OPEN, SETLFS etc are not exposed as kernal calls)
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,77 @@
|
||||
%import textio
|
||||
%import floats
|
||||
%option no_sysinit
|
||||
|
||||
main {
|
||||
sub start() {
|
||||
boing64()
|
||||
}
|
||||
|
||||
sub boing64() {
|
||||
txt.color(4)
|
||||
txt.cls()
|
||||
|
||||
c64.EXTCOL = 12
|
||||
c64.BGCOL0 = 12
|
||||
|
||||
const ubyte size = 24
|
||||
const ubyte center = size / 2
|
||||
const uword radius = size / 2 - 1
|
||||
const float radius_squared = radius*radius as float
|
||||
|
||||
ubyte y, x
|
||||
|
||||
; --- draw the purple grid ---
|
||||
for y in 0 to 24 step 4 {
|
||||
for x in 0 to 39 {
|
||||
txt.setchr(x, y, 160)
|
||||
}
|
||||
}
|
||||
for x in 0 to 39 step 4 {
|
||||
for y in 0 to 24 {
|
||||
txt.setchr(x, y, 160)
|
||||
}
|
||||
}
|
||||
for y in 0 to 24
|
||||
txt.setcc(39, y, 160, 4)
|
||||
|
||||
const ubyte lon_divs = 14
|
||||
const ubyte lat_divs = 7
|
||||
const float tilt_rads = -0.3
|
||||
|
||||
const float cos_a = floats.cos(tilt_rads)
|
||||
const float sin_a = floats.sin(tilt_rads)
|
||||
|
||||
const float half_π = floats.π / 2.0
|
||||
|
||||
|
||||
for y in 0 to size-1 {
|
||||
for x in 0 to size-1 {
|
||||
byte dx = (x - center) as byte
|
||||
byte dy = (y - center) as byte
|
||||
float rx = dx * cos_a - dy * sin_a
|
||||
float ry = dx * sin_a + dy * cos_a
|
||||
float dist_sq = rx*rx + ry*ry
|
||||
|
||||
if dist_sq <= radius_squared {
|
||||
float rz = sqrt(radius_squared - dist_sq)
|
||||
float a = ry/radius
|
||||
float phi = floats.atan(a / sqrt(1 - a * a)) ; asin(ry/radius)
|
||||
float theta = floats.atan2(rx, rz)
|
||||
|
||||
ubyte lon_idx = ((theta + floats.π) / floats.TWOPI * lon_divs) as ubyte
|
||||
ubyte lat_idx = ((phi + half_π) / floats.π * lat_divs + 0.5) as ubyte
|
||||
|
||||
; ubyte color = if (lon_idx + lat_idx) % 2 == 0 then 1 else 2
|
||||
txt.setcc(x + 8, y, 160, 1 + ((lon_idx + lat_idx) & 1))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
txt.color(0)
|
||||
txt.plot(1,1)
|
||||
txt.print("boing!")
|
||||
|
||||
repeat { }
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,75 @@
|
||||
%import palette
|
||||
%import textio
|
||||
%import floats
|
||||
%option no_sysinit
|
||||
%zeropage basicsafe
|
||||
|
||||
main {
|
||||
sub start() {
|
||||
boingx16()
|
||||
}
|
||||
|
||||
sub boingx16() {
|
||||
; adjust purple and red
|
||||
palette.set_color(4, $808)
|
||||
palette.set_color(2, $e00)
|
||||
txt.color2(4, 12)
|
||||
txt.cls()
|
||||
|
||||
const ubyte size = 60
|
||||
const ubyte center = size / 2
|
||||
const uword radius = size / 2 - 4
|
||||
const float radius_squared = radius*radius as float
|
||||
|
||||
ubyte y, x
|
||||
|
||||
; --- draw the purple grid ---
|
||||
for y in 0 to 59 step 8 {
|
||||
for x in 0 to 79 {
|
||||
txt.setchr(x, y, 160)
|
||||
}
|
||||
}
|
||||
for x in 0 to 79 step 8 {
|
||||
for y in 0 to 59 {
|
||||
txt.setchr(x, y, 160)
|
||||
}
|
||||
}
|
||||
|
||||
const ubyte lon_divs = 14
|
||||
const ubyte lat_divs = 7
|
||||
const float tilt_rads = -0.3
|
||||
|
||||
const float cos_a = floats.cos(tilt_rads)
|
||||
const float sin_a = floats.sin(tilt_rads)
|
||||
|
||||
const float half_π = floats.π / 2.0
|
||||
|
||||
|
||||
for y in 0 to size-1 {
|
||||
for x in 0 to size-1 {
|
||||
byte dx = (x - center) as byte
|
||||
byte dy = (y - center) as byte
|
||||
float rx = dx * cos_a - dy * sin_a
|
||||
float ry = dx * sin_a + dy * cos_a
|
||||
float dist_sq = rx*rx + ry*ry
|
||||
|
||||
if dist_sq <= radius_squared {
|
||||
float rz = sqrt(radius_squared - dist_sq)
|
||||
float a = ry/radius
|
||||
float phi = floats.atan(a / sqrt(1 - a * a)) ; asin(ry/radius)
|
||||
float theta = floats.atan2(rx, rz)
|
||||
|
||||
ubyte lon_idx = ((theta + floats.π) / floats.TWOPI * lon_divs) as ubyte
|
||||
ubyte lat_idx = ((phi + half_π) / floats.π * lat_divs + 0.5) as ubyte
|
||||
|
||||
; ubyte color = if (lon_idx + lat_idx) % 2 == 0 then 1 else 2
|
||||
txt.setcc(x + 8, y, 160, 1 + ((lon_idx + lat_idx) & 1))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
txt.color(0)
|
||||
txt.plot(1,1)
|
||||
txt.print("boing!\n")
|
||||
}
|
||||
}
|
||||
+17
-6
@@ -1,13 +1,24 @@
|
||||
%import textio
|
||||
%import strings
|
||||
%import floats
|
||||
%option no_sysinit
|
||||
%import diskio
|
||||
%zeropage basicsafe
|
||||
|
||||
|
||||
main {
|
||||
float f1 = 3.1415927
|
||||
sub start() {
|
||||
txt.print_f(sqrt(f1))
|
||||
cbm.SETNAM(7, "0:blerp")
|
||||
cbm.SETLFS(12, 8, 0)
|
||||
void cbm.OPEN() ; open 12,8,0,"$"
|
||||
cbm.CLOSE(12)
|
||||
|
||||
txt.print(diskio.status())
|
||||
|
||||
;
|
||||
; void cbm.CHKIN(12)
|
||||
;
|
||||
; while cbm.READST()==0 {
|
||||
; cx16.r0L = cbm.CHRIN()
|
||||
; txt.chrout(cx16.r0L)
|
||||
; }
|
||||
;
|
||||
; cbm.CLOSE(12)
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user