diff --git a/source/twilight/rings/M.S b/source/twilight/rings/M.S new file mode 100644 index 0000000..112c734 --- /dev/null +++ b/source/twilight/rings/M.S @@ -0,0 +1,14 @@ + + nol ;turn listing off (NO List) + ovr ;always assemble + + asm rings ;assemble the file + + lnk rings.l + lnk 5/misc + lib 5 + typ EXE + sav rings.d ;useful for testing! + +* typ $BC +* cmd auxtype impulse,$4004 diff --git a/source/twilight/rings/Macros.S b/source/twilight/rings/Macros.S new file mode 100644 index 0000000..00f4dd0 --- /dev/null +++ b/source/twilight/rings/Macros.S @@ -0,0 +1,550 @@ +_BLOCKMOVE MAC + Tool $2B02 + <<< +^DISPOSEALL MAC + PHW ]1 + Tool $1102 + <<< +PEIL MAC + PEI ]1+2 + PEI ]1 + <<< +QUIT_GS MAC + GSOS $2029;]1 + <<< +_STARTCYCLETIMING mac + pea 0 + pea 0 + pea 0 + jsl StartCycleTiming + eom +_CALCCYCLETIME mac + pea #^]1 + pea #]1 + jsl CalcCycleTime + eom +_STARTREALTIMING mac + pea 0 + pea 0 + pea 0 + jsl StartRealTiming + eom +_CALCREALTIME mac + pea #^]1 + pea #]1 + jsl CalcRealTime + eom +^BLOCKMOVE MAC + PxL ]1;]2;]3 + Tool $2B02 + <<< +PXL MAC + DO ]0/1 + PHL ]1 + DO ]0/2 + PHL ]2 + DO ]0/3 + PHL ]3 + DO ]0/4 + PHL ]4 + FIN + FIN + FIN + FIN + <<< +BNEL MAC + BEQ OV + BRL ]1 +OV <<< +^HEXIT MAC + P2SW ]1 + Tool $2A0B + <<< +P2SW MAC + PHA + PHA + IF #=]1 + PEA ]1 + ELSE + IF MX/2 + LDA ]1+1 + PHA + FIN + LDA ]1 + PHA + FIN + <<< +printhex MAC ;format: printhex 'value:';value + ~HexIt ]2 + pll Hascii + printblock #HText + bra x +HText asc ]1 +HAscii asc '0000',00 +x <<< +_INT2DEC MAC + Tool $260B + <<< +_STARTTIMING mac + pea 0 + pea 0 + pea 0 + jsl StartTiming + eom +_CALCTIME mac + pea #^]1 + pea #]1 + jsl CalcTime + eom +_DISPOSEHANDLE MAC + Tool $1002 + <<< +_TOTALMEM MAC + Tool $1D02 + <<< +CLOSE_GS MAC + GSOS $2014;]1 + <<< +OPEN_GS MAC + GSOS $2010;]1 + <<< +READ_GS MAC + GSOS $2012;]1 + <<< +GSOS MAC + jsl $E100A8 + da ]1 + adrl ]2 + <<< +_READTIMEHEX MAC + Tool $D03 + <<< +_TICKCOUNT MAC + Tool $1006 + <<< +_DISPOSEALL MAC + Tool $1102 + <<< +_SETHANDLESIZE MAC + Tool $1902 + <<< +_FINDHANDLE MAC + Tool $1A02 + <<< +_HLOCK MAC + Tool $2002 + <<< +BCCL MAC + BCS OV + BRL ]1 +OV <<< +BLTL MAC + BGE OV + BRL ]1 +OV <<< +SUB MAC + IF #=]2 + IF #=]1 + ERR 1 + FIN + FIN + SEC + LDA ]1 + SBC ]2 + DO ]0/3 + STA ]3 + ELSE + IF #=]2 + STA ]1 + ELSE + STA ]2 + FIN + FIN + IF MX>1 + LDHI ]1 + IF #=]2 + SBC ]2/$100 + ELSE + SBC ]2+1 + FIN + DO ]0/3 + STA ]3+1 + ELSE + IF #=]2 + STA ]1+1 + ELSE + STA ]2+1 + FIN + FIN + FIN + <<< +LDHI MAC + IF #=]1 + LDA ]1/$100 + ELSE + LDA ]1+1 + FIN + <<< +^DISPOSEHANDLE MAC + PHL ]1 + Tool $1002 + <<< +_UNPACKBYTES MAC + Tool $2703 + <<< +_HEXIT MAC + Tool $2A0B + <<< +_TEXTSTARTUP MAC + Tool $20C + <<< +_TEXTSHUTDOWN MAC + Tool $30C + <<< +^WRITECSTRING MAC + PHL ]1 + Tool $200C + <<< +ADD MAC + IF #=]2 + IF #=]1 + ERR 1 + FIN + FIN + CLC + LDA ]1 + ADC ]2 + DO ]0/3 + STA ]3 + ELSE + IF #=]2 + STA ]1 + ELSE + STA ]2 + FIN + FIN + IF MX>1 + LDA ]1+1 + IF #=]2 + ADC ]2/$100 + ELSE + ADC ]2+1 + FIN + DO ]0/3 + STA ]3+1 + ELSE + IF #=]2 + STA ]1+1 + ELSE + STA ]2+1 + FIN + FIN + FIN + <<< +BCSL MAC + BCC OV + BRL ]1 +OV <<< +ADD4 MAC + CLC + DO ]0/3 + IF #=]1 + LDA #<]1 + ELSE + LDA ]1 + FIN + IF #=]2 + ADC #<]2 + ELSE + ADC ]2 + FIN + STA ]3 + IF #=]1 + LDA #^]1 + ELSE + LDA ]1+2 + FIN + IF #=]2 + ADC #^]2 + ELSE + ADC ]2+2 + FIN + STA ]3+2 + ELSE + IF #=]1 + ADC #<]1 + ELSE + ADC ]1 + FIN + STA ]2 + IF #=]1 + LDA #^]1 + ELSE + LDA ]1+2 + FIN + ADC #0 + STA ]2+2 + FIN + <<< +SUB4 MAC + SEC + DO ]0/3 + IF #=]1 + LDA #<]1 + ELSE + LDA ]1 + FIN + IF #=]2 + SBC #<]2 + ELSE + SBC ]2 + FIN + STA ]3 + IF #=]1 + LDA #^]1 + ELSE + LDA ]1+2 + FIN + IF #=]2 + SBC #^]2 + ELSE + SBC ]2+2 + FIN + STA ]3+2 + ELSE + IF #=]1 + SBC #<]1 + ELSE + SBC ]1 + FIN + STA ]2 + IF #=]1 + LDA #^]1 + ELSE + LDA ]1+2 + FIN + SBC #0 + STA ]2+2 + FIN + <<< +_OPEN MAC + DOS16 $10;]1 + <<< +_NEWLINE MAC + DOS16 $11;]1 + <<< +_READ MAC + DOS16 $12;]1 + <<< +_CLOSE MAC + DOS16 $14;]1 + <<< +_GET_EOF MAC + DOS16 $19;]1 + <<< +^NEWHANDLE MAC + P2SL ]1 + PxW ]2;]3 + PHL ]4 + Tool $902 + <<< +PXW MAC + DO ]0/1 + PHW ]1 + DO ]0/2 + PHW ]2 + DO ]0/3 + PHW ]3 + DO ]0/4 + PHW ]4 + FIN + FIN + FIN + FIN + <<< +P2SL MAC + PHA + PHA + IF #=]1 + PEA ^]1 + ELSE + PHW ]1+2 + FIN + PHW ]1 + <<< +BGT MAC + BEQ OV + BGE ]1 +OV <<< +^MTSTARTUP MAC + Tool $203 + <<< +^MTSHUTDOWN MAC + Tool $303 + <<< +^MMSTARTUP MAC + PHA + Tool $202 + <<< +^MMSHUTDOWN MAC + PHW ]1 + Tool $302 + <<< +_QUIT MAC + DOS16 $29;]1 + <<< +DOS16 MAC + JSL $E100A8 + DA ]1 + ADRL ]2 + <<< +TOOL MAC + LDX #]1 + JSL $E10000 + <<< +************************************************** +key MAC + ldal $E0C000 + bmi x + brl ]1 +x + stal $E0C010 + <<< +check MAC check string exactly + mvl #Input_Buffer;String_Source + mvl ]1;String_Object + jsr Check_String + bcsl ]2 if not, then goto ]2 + <<< +find MAC find string occurance + mvl #Input_Buffer;String_Source + mvl ]1;String_Object + jsr Find_String + bcsl ]2 if not, then goto ]2 + <<< +request MAC + printxy ]1;]2;]3 + mvl #Input_Buffer;String_Source + jsr get_String + <<< +printxy MAC + mvw ]1;XLoc + mvw ]2;YLoc + mvl #s;String_Source + jsr Draw_Text + bra x +s asc ]3,00 +x <<< +print MAC + mvl #s;String_Source + jsr Draw_Text + bra x +s asc ]1,00 +x <<< +printblockxy MAC draw shr text characters + mvw ]1;XLoc + mvw ]2;YLoc + mvl ]3;string_source + jsr Draw_Text + <<< +printblock MAC draw shr text characters + mvl ]1;string_source + jsr Draw_Text + <<< +phw MAC push word + if #=]1 + pea ]1 + else + if MX/2 + lda ]1+1 + pha + fin + lda ]1 + pha + fin + <<< +plw MAC pull word + pla + sta ]1 + <<< +mvw MAC move word + lda ]1 + DO ]0/2 + STA ]2 + DO ]0/3 + STA ]3 + DO ]0/4 + STA ]4 + FIN + FIN + FIN + <<< +mvl MAC move long + lda ]1 + do ]0/2 + sta ]2 + do ]0/3 + sta ]3 + do ]0/4 + sta ]4 + fin + fin + fin + if #=]1 + lda ^]1 + else + lda ]1+2 + fin + do ]0/2 + sta ]2+2 + do ]0/3 + sta ]3+2 + do ]0/4 + sta ]4+2 + fin + fin + fin + <<< +phl MAC push long + if #=]1 + pea ^]1 + else + phw ]1+2 + fin + phw ]1 + <<< +PLL MAC + PLA + DO ]0/1 + STA ]1 + DO ]0/2 + STA ]2 + DO ]0/3 + STA ]3 + DO ]0/4 + STA ]4 + FIN + FIN + FIN + FIN + PLA + DO ]0/1 + STA ]1+2 + DO ]0/2 + STA ]2+2 + DO ]0/3 + STA ]3+2 + DO ]0/4 + STA ]4+2 + FIN + FIN + FIN + FIN + <<< +BEQL MAC + BNE OV + BRL ]1 +OV <<< +_MMSHUTDOWN MAC + Tool $302 + <<< diff --git a/source/twilight/rings/impulse.s b/source/twilight/rings/impulse.s new file mode 100644 index 0000000..dff26a1 --- /dev/null +++ b/source/twilight/rings/impulse.s @@ -0,0 +1,2365 @@ + +************************************************** +* FTA/DYA Three-D T2 Module "Impulse" * +* * +* Originally by FTA. * +* Enhanced by Jim Maricondo, DYA. * +************************************************** + lst off + rel + xc + xc + mx %00 + TR OFF + + USE MACROS + USE MACROS2 + + put t2common.equ + + case se + +rele = 1 + +*================================================= +* Etalon = Zoom, Pnt = Ptr, VIT = SPEED +* BOU = LOOP, Comptuer = Counter, Calculateur = +* Calculator, Moins = Minus +*------------------------------------------------- +FPSCtlID = 1 +DelayPopCtlID = 2 +ShapePopCtlID = 3 +MaxZoomCtlID = 8 +CtlLst = 1 +resourceToResource = 9 + +* Bits of ImpulseFlag... +fFPSCounter = 1 +fBigShapes = 2 + +* SendRequest sendHow values +stopAfterOne equ $8000 +sendToAll equ 0 +sendToName equ 1 +sendToUserID equ 2 + +* NewHandle attributes +attrNoPurge equ $0000 ; Handle Attribute Bits - Not purgeable +attrBank equ $0001 ; Handle Attribute Bits - fixed bank +attrAddr equ $0002 ; Handle Attribute Bits - fixed address +attrPage equ $0004 ; Handle Attribute Bits - page aligned +attrNoSpec equ $0008 ; Handle Attribute Bits - may not use speci +attrNoCross equ $0010 ; Handle Attribute Bits - may not cross ba +attrFixed equ $4000 ; Handle Attribute Bits - not movable +attrLocked equ $8000 ; Handle Attribute Bits - locked + +Screen = $E12000 +*------------------------------------------------- + dum 1 +****dp da 0 +Bank db 0 ;This is how the stack is set up +rtlAddr adr 0 ;with DP at the top and Result +T2data2 adrl 0 ;occupying the top four bytes +T2data1 adrl 0 +T2Message da 0 +T2Result adrl 0 +T2StackSize adrl 0 + dend +*------------------------------------------------- + DUM $00 +Max DS 2 +Perspective DS 2 +Zoom_Step DS 2 +Zoom_Max DS 2 +Curve_Pointer DS 2 +L1 DS 2 ;Variable des routines de line +L2 DS 2 ;en entree L1,C1 et L2,C2 +C1 DS 2 ;contiennent les coordonnees sur 16 bits +C2 DS 2 ;des 2 bouts (Origine en haut a gauche) +DY DS 2 +DX DS 2 +UT DS 2 +ADR DS 2 +NBR DS 2 +Buf DS 2 +RESULT DS 4 ;32 bits RESULT = ENTER1 * ENTER2 +INDEX DS 5 ;40 bits Pointeur de calcul d'index +ENTER1 DS 2 ;16 bits +ENTER2 DS 2 ;16 bits +ANGX DS 2 ;9 bits +ANGY DS 2 ; " +ANGZ DS 2 ; " +Zoom DS 2 ; " +SGN_11 DS 2 ; <-bug!!!! +SGN_12 DS 2 +SGN_21 DS 2 +SGN_22 DS 2 +SGN_23 DS 2 +SGN_32 DS 2 +VAL_11 DS 2 +VAL_12 DS 2 +VAL_21 DS 2 +VAL_22 DS 2 +VAL_23 DS 2 +VAL_32 DS 2 +NVAL_22 DS 2 +NSGN_22 DS 2 +NVAL_12 DS 2 +NSGN_12 DS 2 +NSGN_33 DS 2 +NVAL_33 DS 2 +NSGN_11 DS 2 +NVAL_11 DS 2 +NSGN_21 DS 2 +NVAL_21 DS 2 +NSGN_31 DS 2 +NVAL_31 DS 2 +NSGN_13 DS 2 +NVAL_13 DS 2 +NSGN_23 DS 2 +NVAL_23 DS 2 +NVAL_32 DS 2 +SGN_33 DS 2 +VAL_33 DS 2 +SGN_13 DS 2 +VAL_13 DS 2 +Buf_SGN DS 2 +Buf_VAL DS 2 +Rx DS 2 +Ry DS 2 +Rz DS 2 +Cx DS 2 +Cy DS 2 +OLD_L2 DS 2 +OLD_C2 DS 2 +Ptr DS 2 +Pnt2 DS 2 +Curve_Adr DS 2 +SPEEDX DS 2 +SPEEDY DS 2 +SPEEDZ DS 2 +Max_X DS 2 +Max_Y DS 2 +Max_Z DS 2 +CorX DS 2 +Result DS 2 +Ptr_Clear DS 4 +Ptr_Tsb DS 4 +Ptr_Tsb2 DS 4 +Old DS 2 +Cur_Curve ds 2 +ZoomOut ds 2 +ZoomIn ds 2 +fps_offset ds 2 +fps_dir ds 2 +Bank1Ptr ds 4 +Bank2Ptr ds 4 +Bank3Ptr ds 4 +MovePtr ds 4 +DestTick ds 4 + ERR *>$FF + DEND +*================================================= + mx %00 + +Start + phb + phk + plb + tdc + sta OurDP + +* brk 00 + + lda T2Message,s + cmp #BlankT2 + beq doBlank + cmp #MakeT2 + beql doMake + cmp #HitT2 + beql doHit +* cmp #KillT2 +* beql doKill + cmp #SaveT2 + beql doSave + cmp #LoadSetupT2 + beql doLoadSetup +* cmp #UnloadSetupT2 +* beql doUnloadSetup + brl Bye + +*------------------------------------------------- +doBlank = * + LDX #$FE ; init our DP +]lp STZ $00,X + DEX + DEX + BPL ]lp + + lda T2data1,s + sta MovePtr ;save this in our own DP + lda T2data1+2,s + sta MovePtr+2 + +* lda T2data2,s +* sta RezFileID + + ~MMStartUp + pla + ora #$0100 + sta MyID + +* lda T2data2+2,s ;our memory ID +* ora #$0100 +* sta MyID + + lda #-1 + sta OneSecStarted + + + jsr malloc + bcc :allocOk + tay ; save error number + lda #1 ; not enough memory (requires 192k) + brl ErrorMaker + +:allocOk + SEP #$30 + ldal $E0C035 + REP #$30 + and #$FF + bit #$08 + beq :shadowOk + ldy #0 ; error $0000 + lda #2 ; shadowing not available + brl ErrorMaker + +:shadowOk + + PushLong #toT2String + jsl init_random + + lda Bank1Ptr + sta Rout_Tsb+1 + lda Bank1Ptr+1 + sta Rout_Tsb+2 + lda Bank3Ptr + sta ClearFill+1 + lda Bank3Ptr+1 + sta ClearFill+2 + + LDA #1 ; start filling in first operand + STA Ptr_Clear + STA Ptr_Tsb + STA Ptr_Tsb2 + LDA Bank3Ptr+2 ; init pointers + STA Ptr_Clear+2 + LDA Bank1Ptr+2 + STA Ptr_Tsb+2 + SEP #$20 + STA Rout_Tsb+3 ; patch in Tsb routine 1 to start + REP #$20 + lda Bank2Ptr+2 ; init pointer + STA Ptr_Tsb2+2 + +* fill in the opcodes into our rapidfast clear and show routines +* bank1 = tsb1 +* bank2 = tsb2 +* bank3 = clear + + ldy #0 +]lp LDA #$9C ; STZ OP + STA [Bank3Ptr],y ; clear + LDA #$0C ; TSB OP + sta [Bank1Ptr],y ; tsb1 + sta [Bank2Ptr],y ; tsb2 + iny +* LDA #0 +* sta [Bank1Ptr],y +* sta [Bank2Ptr],y +* sta [Bank3Ptr],y + iny + iny + cpy #$FF00 + BCC ]lp + + ldx #$8000-2 ; clear the shr shadowed memory area + lda #0 +]lp stal $012000,x + dex + dex + bpl ]lp + + + jsr Setup_3d + jsr New_Curve + + stz Zoom + lda #1 + sta ZoomIn + + lda ImpulseFlag + and #fFPSCounter ; fps off/on + beq :no_fps + + JSR Init_Counter ; init fps counter +:no_fps + + LDAL $E0C035 ; make sure shr shadowing is off + ora #$08 + STAL $E0C035 + bra TOP + +return = * + lda ImpulseFlag + and #fFPSCounter ; fps off/on + beq no_fps2 + + lda OneSecStarted + bne :skip + ~IntSource #7 ; disable 1sec + +:skip lda #$0000 +org_patch1 = *-2 + stal $E10054 + lda #$0000 +org_patch2 = *-2 + stal $E10056 + +no_fps2 + ~DisposeAll MyID + lda MyID + and #$F0FF + pha + _MMShutDown + +Bye = * +skip = * + plb + lda 1,s ; move up RTL address + sta 1+10,s + lda 2,s + sta 2+10,s + tsc ; Remove input parameters. + clc + adc #10 + tcs + clc + rtl +*------------------------------------------------- +TOP + + lda ZoomOut + beq no_Zout + + + + LDA Zoom + SEC + SBC Zoom_Step + BCS Not_Min + + + + lda ImpulseShapes + cmp #1 ; all + bne :nonew + jsr New_Curve +:nonew + + + stz ZoomOut + lda #1 + sta ZoomIn + lda #0 +Not_Min STA Zoom + + +no_Zout lda ZoomIn + beq no_Zin + + LDA Zoom + CLC + ADC Zoom_Step + CMP Zoom_Max + blt Not_Max + stz ZoomIn + + +* multiply it by 10 to get seconds, then by 60 to get ticks, or by 600 for both +* 512+64+16+8 = 600 +* 2^9 + 2^6 + 2^4 + 2^3 = 600 + + lda ImpulseFlag ; delay in hi byte + xba + and #$FF + asl ; x2 + asl ; x4 + asl ; x8 + pha ; 2^3 + asl ; x16 + pha ; 2^4 + asl ; x32 + asl ; x64 + pha ; 2^6 + asl ; x128 + asl ; x256 + asl ; x512 = 2^9 + clc + adc 1,s ; +2^6 + adc 3,s ; +2^4 + adc 5,s ; +2^3 + sta ticks+1 + plx + _GetTick + pla + plx + clc +ticks adc #1200 + sta DestTick + txa + adc #0 + sta DestTick+2 + lda Zoom_Max +Not_Max STA Zoom + +no_Zin JSR Calculator ; calculate cos/sin's for current angles + + INC Cmpt_Frame ; increment frame count + + SEP #$30 + LDA Rout_Tsb+3 + cmp Bank1Ptr+2 + beq tsb2_nxt + lda Bank1Ptr+2 + sta Rout_Tsb+3 +Clear2 LDA #1 + STA Ptr_Tsb2 + STZ Ptr_Tsb2+1 + BRA Cont_Clear +tsb2_nxt lda Bank2Ptr+2 + sta Rout_Tsb+3 + LDA #1 + STA Ptr_Tsb + STZ Ptr_Tsb+1 + +Cont_Clear REP #$30 + + lda Curve_Adr + cmp #Curve_Rebound + bne not_rebound + JSR Update_Rebound + +not_rebound + LDA #1 ; reinit operand offset into STZ routine + STA Ptr_Clear + + STZ Old ; init last shr addr plotted variable + + LDA #14+2 ; init offset into shape to 14 + STA Buf ; (Start of the shape definition) + +]loop LDY Buf + LDA (Curve_Adr),Y + AND #$00FF + CMP #$00FF ; have we reached the end of the shape def? + BEQ End_Cycle ; yes, so we're finished updating it this frame. + BIT #%0000_0000_1000_0000 ; at the start of a new line element? + BEQ No_New_Enter ; no, so connect this new point to the last. + AND #%0000_0000_0111_1111 ; yes, so first and out the msb + ASL ; x2 + PHA ; save X + INY + LDA (Curve_Adr),Y ; get Y of this point + AND #$00FF + ASL + TAX + INY + LDA (Curve_Adr),Y ; get Z + AND #$00FF + ASL + PLY + JSR Calc_Curve ; find screen coordinates of X,Y,Z + INC Buf ; move to next point + INC Buf + INC Buf + BRA Cont ; move to connecting point. +No_New_Enter LDA OLD_L2 ; draw a line from the last point to this + LDY OLD_C2 ; current point. +Cont STA L1 ; store the calculated screen coordinates of the + STY C1 ; last point/current point. + LDY Buf ; retrieve offset into shape + LDA (Curve_Adr),Y ; get new X + AND #$00FF + ASL + PHA + INY + LDA (Curve_Adr),Y ; get new Y + AND #$00FF + ASL + TAX + INY + LDA (Curve_Adr),Y ; get new Z + AND #$00FF + ASL + PLY + JSR Calc_Curve ; find screen coordinates of X,Y,Z + STA L2 ; store screen coordinates + STA OLD_L2 + STY C2 + STY OLD_C2 +* bcc skiphline + JSR HLine ; draw a line between the last point and this one +* skiphline + INC Buf ; move on to next point + INC Buf + INC Buf + BRA ]loop + +End_Cycle add ANGX;SPEEDX ; adjust our angles by the speeds + add ANGY;SPEEDY + add ANGZ;SPEEDZ + + sep $30 + ldal $E0C035 + and #$F7 + stal $E0C035 ; shr shadowing on + rep $30 + + DEC Ptr_Tsb ; move back ptrs from operand to opcode + DEC Ptr_Tsb2 + DEC Ptr_Clear + LDA #$6B ; RTL + STA [Ptr_Clear] ; store it in all 3 routines at the end of the + STA [Ptr_Tsb] ; filled in operands for this frame + STA [Ptr_Tsb2] + PHB + PEA $0101 + PLB + PLB +Rout_Tsb JSL $000000 ; update the next frame so we can see it onscreen + PLB + + lda ZoomIn + bne :skip + lda ZoomOut + bne :skip + + + lda ImpulseShapes + cmp #1 ; all + bne :skip + JSR Test_Key ; handle keypresses (time to zoom out?) +:skip lda [MovePtr] + BNEL return + +* LDA $C035 ; make sure shadowing is now OFF +* ORA #$801E ; (and insure fast speed while we're at it :) +* STA $C035 + + ldal $E0C035 + ora #$08 + stal $E0C035 + + PHB + PEA $0101 + PLB + PLB +ClearFill JSL $000000 ; erase lines from last frame + PLB + + LDA #$9C ; put STZ opcode back over the RTL + STA [Ptr_Clear] + AND #$0F ; put TSB opcode back over the RTL (FTA;0C) + STA [Ptr_Tsb] + STA [Ptr_Tsb2] + INC Ptr_Tsb + INC Ptr_Tsb2 + + BRL TOP ; next frame! + +*================================================= +malloc = * + +* brk $ff + +* Get one bank of attrLocked+attrFixed+attrNoSpec+attrAddr memory + + ~NewHandle #$FFFF;MyID;#attrLocked+attrPage+attrFixed+attrNoSpec+attrNoCross;#$000000 + bcc :goodMem1 + plx + plx + sec + rts + +:goodMem1 + phd + tsc + tcd + ldy #2 + lda [3] + tax + lda [3],y + sta <5 + stx <3 + pld + pla + sta Bank1Ptr + pla + sta Bank1Ptr+2 + + +* ~NewHandle #$010000;MyID;#$C00A;#$000000 +* ~NewHandle #$FFFF;MyID;#attrLocked+attrFixed+attrNoSpec+attrAddr;#$000000 + ~NewHandle #$FFFF;MyID;#attrLocked+attrPage+attrFixed+attrNoSpec+attrNoCross;#$000000 + bcc :goodMem2 + plx + plx + sec + rts + +:goodMem2 + phd + tsc + tcd + ldy #2 + lda [3] + tax + lda [3],y + sta <5 + stx <3 + pld + pla + sta Bank2Ptr + pla + sta Bank2Ptr+2 + + +* Get one bank of attrLocked+attrFixed+attrNoSpec+attrAddr memory + +* ~NewHandle #$010000;MyID;#$C00A;#$000000 +* ~NewHandle #$FFFF;MyID;#attrLocked+attrFixed+attrNoSpec+attrAddr;#$000000 + ~NewHandle #$FFFF;MyID;#attrLocked+attrPage+attrFixed+attrNoSpec+attrNoCross;#$000000 + bcc :goodMem3 + plx + plx + sec + rts + +:goodMem3 + phd + tsc + tcd + ldy #2 + lda [3] + tax + lda [3],y + sta <5 + stx <3 + pld + pla + sta Bank3Ptr + pla + sta Bank3Ptr+2 + clc + rts + +*------------------------------------------------- +* take the data from the shape header and stuff +* it in the right variables + +Get_Curve = * + + lda ImpulseFlag + bit #fBigShapes + bne :yes + + ldy #02 + LDA (Curve_Adr) + bra :no + +:yes LDY #02 + LDA (Curve_Adr),Y +:no STA Zoom_Max + STA Zoom + LSR + LSR + LSR + LSR + LSR + LSR + AND #%0000_0011_1111_1111 + STA Zoom_Step + INY + INY + LDA (Curve_Adr),Y + STA Max_X + INY + INY + LDA (Curve_Adr),Y + STA Max_Y + INY + INY + LDA (Curve_Adr),Y + STA Max_Z + INY + INY + LDA (Curve_Adr),Y + STAL $E19E1E + INY + INY + LDA (Curve_Adr),Y + STAL $E19E02 + INY + INY + LDA (Curve_Adr),Y + STA Perspective + LDA Max_X + CMP Max_Y + BCC XMax0 + LDA Max_Y +XMax0 CMP Max_Z + BCS YMax0 + LDA Max_Z +YMax0 XBA + AND #$FF00 + ASL + STA Max + RTS + +*------------------------------------------------- + +Setup_3d = * + + LDA #0-2 ; init speeds and angles + STA SPEEDX + LDA #0-4 + STA SPEEDY + LDA #0+2 + STA SPEEDZ + STZ ANGX + STZ ANGY + STZ ANGZ + rts + +*------------------------------------------------- + +Update_Rebound PHP + SEP #$30 + LDX #0 +Pos_Rebond = *-1 + LDA Rebond_Sol,X + STA AltSol0 + STA AltSol1 + LDA #s + SEC + SBC Rebond_Obj,X + STA AltObj1 + STA AltObj2 + STA AltObj3 + STA AltObj4 + STA AltObj5 + STA AltObj6 + STA AltObj7 + STA AltObj8 + ORA #%1000_0000 + STA AltObj0 + SEC + SBC #4 + STA AltBas0 + STA AltBas1 + STA AltBas2 + STA AltBas3 + INX + CPX #20 + BCC No_DepRebond + LDX #0 +No_DepRebond STX Pos_Rebond + PLP + RTS + mx %00 + +*------------------------------------------------- + +Calc_Curve = * + STA Rz + STY Rx + STX Ry + LDA Perspective + BEQ Calcul_Perspective + BRL Calc_CurveOld +Calcul_Perspective LDX Rz + LDA Table_31,X + CLC + LDX Rx + ADC Table_21,X + LDX Ry + ADC Table_11,X + ADC Max + STA CorX + LDX Rz + LDA Table_32,X + LDX Rx + CLC + ADC Table_22,X + LDX Ry + ADC Table_12,X + BPL Positif_Y +Negatif_Y + EOR #$FFFF ;Divise Abs(Y) par CorX + INC + STZ Result + LUP 6 + CMP CorX + BCC *+4 + SBC CorX + ROL Result + ASL + --^ + CMP CorX + BCC *+4 + SBC CorX + ROL Result + LDA #161 + SEC + SBC Result + BRA SuiteZ + +Positif_Y STZ Result ;Divise Abs(Y) par CorX + LUP 6 + CMP CorX + BCC *+4 + SBC CorX + ROL Result + ASL + --^ + CMP CorX + BCC *+4 + SBC CorX + ROL Result + LDA #161 + CLC + ADC Result +SuiteZ TAY + + LDX Rz + LDA Table_33,X + LDX Rx + CLC + ADC Table_23,X + LDX Ry + ADC Table_13,X + BPL Positif_Z +Negatif_Z + EOR #$FFFF ;Divise Abs(Z) par CorX + INC + STZ Result + LUP 6 + CMP CorX + BCC *+4 + SBC CorX + ROL Result + ASL + --^ + CMP CorX + BCC *+4 + SBC CorX + ROL Result + LDA #100 + SEC + SBC Result + do 0 + cmp #100 + bcs nodraw + sec + RTS +nodraw clc + fin + rts + +Positif_Z STZ Result ;Divise Abs(Y) par CorX + LUP 6 + CMP CorX + BCC *+4 + SBC CorX + ROL Result + ASL + --^ + CMP CorX + BCC *+4 + SBC CorX + ROL Result + LDA #100 + CLC + ADC Result ; Lgn + do 0 + cmp #100 + fin + RTS + +*------------------------------------------------- + +Test_Key = * + ~GetTick + pla + plx + cpx DestTick+2 + blt notYet + cmp DestTick + blt notYet + lda ZoomOut + bne notYet ; already zooming (not needed) + do 0 + inc Cur_Curve + fin + lda #1 + sta ZoomOut ; ZoomOut = TRUE + stz ZoomIn ; ZoomIn = FALSE +notYet rts + + do 0 +Test_Key SEP #$20 + LDAL $E0C000 + STAL $E0C010 + REP #$20 + AND #$00FF + CMP #"0" + BNE No_Zero + STZ ANGX + STZ ANGZ + STZ SPEEDX + STZ SPEEDZ + LDA #0-4 + STA SPEEDY + RTS +No_Zero CMP #"7" + BNE No_7 + DEC SPEEDZ + RTS +No_7 CMP #"8" + BNE No_8 + STZ SPEEDZ + RTS +No_8 CMP #"9" + BNE No_9 + INC SPEEDZ + RTS +No_9 CMP #"4" + BNE No_4 + DEC SPEEDY + RTS +No_4 CMP #"5" + BNE No_5 + STZ SPEEDY + RTS +No_5 CMP #"6" + BNE No_6 + INC SPEEDY + RTS +No_6 CMP #"1" + BNE No_1 + DEC SPEEDX + RTS +No_1 CMP #"2" + BNE No_2 + STZ SPEEDX + RTS +No_2 CMP #"3" + BNE No_3 + INC SPEEDX + RTS +No_3 CMP #"+" + BNE No_Plus +Zoom_In LDA Zoom + CLC + ADC Zoom_Step + CMP Zoom_Max ; implement this later ? +No_Max STA Zoom + RTS +No_Plus CMP #"-" + BNE No_Minus +Zoom_Off LDA Zoom + SEC + SBC Zoom_Step + BCS No_Min + LDA #0 +No_Min STA Zoom + RTS +No_Minus CMP #"*" + bne No_Star + lda ZoomOut + bne alreadyzooming + inc Cur_Curve + lda #1 + sta ZoomOut ; ZoomOut = TRUE +alreadyzooming stz ZoomIn ; ZoomIn = FALSE + rts +No_Star cmp #$1B + bne No_Esc + sta Escape ; escape = TRUE +No_Esc rts + fin + +*------------------------------------------------- + +Calc_CurveOld = * + LDX Rz + LDA Table_31,X + CLC + LDX Rx + ADC Table_21,X + LDX Ry + ADC Table_11,X + ADC #161*128 + LSR + LSR + LSR + LSR + LSR + LSR + LSR + AND #%0000_0001_1111_1111 + TAY + LDX Rz + LDA Table_32,X + LDX Rx + CLC + ADC Table_22,X + LDX Ry + ADC Table_12,X + ADC #100*128 + LSR + LSR + LSR + LSR + LSR + LSR + LSR + AND #%0000_0001_1111_1111 + RTS + +*------------------------------------------------- + +Calculator = * + REP #$30 + + LDA ANGX + ASL + TAX + LDA Table_Cos+$400,X + STA SGN_11 + STA NSGN_22 + LDA Table_Cos,X + LDY Zoom + JSR FOIS + STA VAL_11 ; En premier la ligne + STA NVAL_22 + LDA ANGX + ASL + TAX + LDA Table_Sin+$400,X + STA SGN_21 + EOR #1 + STA NSGN_12 + LDA Table_Sin,X + LDY Zoom + JSR FOIS + STA VAL_21 + STA NVAL_12 + +* Actif : VAL_11,NVAL_12,VAL_21,NVAL_22 33=Zoom + + LDA ANGY + ASL + TAX + LDA Table_Cos+$400,X + PHA + STA NSGN_33 + EOR SGN_11 + STA NSGN_11 + PLA + EOR SGN_21 + STA NSGN_21 + LDA Table_Cos,X + PHA + LDY VAL_11 + JSR FOIS + STA NVAL_11 ; * + LDA $01,S + LDY Zoom + JSR FOIS + STA NVAL_33 + PLA + LDY VAL_21 + JSR FOIS + STA NVAL_21 ; * + LDA ANGY + ASL + TAX + LDA Table_Sin+$400,X + STA NSGN_31 + EOR #1 + PHA + EOR SGN_11 + STA NSGN_13 + PLA + EOR SGN_21 + STA NSGN_23 + LDA Table_Sin,X + PHA + LDY VAL_11 + JSR FOIS + STA NVAL_13 + LDA $01,S + LDY VAL_21 + JSR FOIS + STA NVAL_23 + PLA + LDY Zoom + JSR FOIS + STA NVAL_31 ; * + + LDA ANGZ + ASL + TAX + LDA Table_Sin+$400,X + PHA + EOR NSGN_33 + STA SGN_32 + PLA + EOR NSGN_13 + STA Buf_SGN + LDA Table_Sin,X + PHA + LDY NVAL_33 + JSR FOIS + STA VAL_32 ; * + PLA + LDY NVAL_13 + JSR FOIS + STA Buf_VAL + LDA ANGZ + ASL + TAX + LDA Table_Cos+$400,X + EOR NSGN_12 + STA SGN_12 + PHA + LDA Table_Cos,X + LDY NVAL_12 + JSR FOIS + PLY + Add Buf_SGN;Buf_VAL;SGN_12;VAL_12 + LDA ANGZ + ASL + PHA + TAX + LDA Table_Sin+$400,X + EOR NSGN_23 + STA Buf_SGN + LDA Table_Sin,X + LDY NVAL_23 + JSR FOIS + STA Buf_VAL + PLX + LDA Table_Cos+$400,X + EOR NSGN_22 + STA SGN_22 + PHA + LDA Table_Cos,X + LDY NVAL_22 + JSR FOIS + PLY + Add Buf_SGN;Buf_VAL;SGN_22;VAL_22 + + TABLE_SPECIAL NVAL_11;NSGN_11;Table_11;Max_X + TABLE_SPECIAL NVAL_21;NSGN_21;Table_21;Max_Y + TABLE_SPECIAL NVAL_31;NSGN_31;Table_31;Max_Z + + TABLE VAL_12;SGN_12;Table_12;Max_X + TABLE VAL_22;SGN_22;Table_22;Max_Y + TABLE VAL_32;SGN_32;Table_32;Max_Z + + + LDA Perspective + BEQ Calc_Z + + RTS +Calc_Z = * + + LDA ANGZ + ASL + TAX + LDA Table_Sin+$400,X + EOR #1 + EOR NSGN_12 + STA Buf_SGN + LDA Table_Sin,X + LDY NVAL_12 + JSR FOIS + STA Buf_VAL + LDA ANGZ + ASL + TAX + LDA Table_Cos+$400,X + PHA + EOR NSGN_33 + STA SGN_33 ; * + PLA + EOR NSGN_13 + STA SGN_13 + PHA + LDA Table_Cos,X + PHA + LDY NVAL_33 + JSR FOIS + STA VAL_33 ; * + PLA + LDY NVAL_13 + JSR FOIS + PLY + Add Buf_SGN;Buf_VAL;SGN_13;VAL_13 + + LDA ANGZ + ASL + PHA + TAX + LDA Table_Sin+$400,X + EOR #1 + EOR NSGN_22 + STA Buf_SGN + LDA Table_Sin,X + LDY NVAL_22 + JSR FOIS + STA Buf_VAL + PLX + LDA Table_Cos+$400,X + EOR NSGN_23 + STA SGN_23 + PHA + LDA Table_Cos,X + LDY NVAL_23 + JSR FOIS + PLY + Add Buf_SGN;Buf_VAL;SGN_23;VAL_23 + + TABLE VAL_13;SGN_13;Table_13;Max_X + TABLE VAL_23;SGN_23;Table_23;Max_Y + TABLE VAL_33;SGN_33;Table_33;Max_Z + + RTS + +*------------------------------------------------- +*********************************** +* Multiply * +* 16 bit x 16 bit = 32 bit result * +* - Call with input in A and Y * +* - Returns with output in result * +*********************************** + + +FOIS = * +Multiply + php + rep $30 + + lr + pha + phy + ldx #$090b ; multiply + jsl $e10000 + plx + pla + bcc ]noerr + lda #0 + tax +]noerr stx RESULT + sta RESULT+2 + + do 0 + stz RESULT + sta multiplic + ldx #16 + tya +:mult1 lsr + lda RESULT + bcc :mult2 + clc + adc multiplic +:mult2 ror + sta RESULT + tya + ror + tay + dex + bne :mult1 + sty RESULT+2 + cpy #0 + bne :overflow + lda RESULT+2 ;RESULT + fin + plp + rts + + do 0 +:overflow brk $FF + lda #0 + sta RESULT + sta RESULT+2 + plp + rts +multiplic ds 2 + fin + +*------------------------------------------------- +* HLine - FTA's famous line routine. +* On entry: +* L1 - line of first point +* C1 - column of first point (in bytes) +* L2 - line of second point +* C2 - column of second point +* The routine will connect the two points with a line. +* + MX %00 + +HLine = * + +* STA L2 +* STY C2 + + LDA L1 + CMP L2 + BCC ZNO_INV2 + LDY L2 + STA L2 + STY L1 + LDA C1 + LDY C2 + STY C1 + STA C2 +ZNO_INV2 = * + LDA L1 ;Calcule l'adresse base de trace + ASL + ASL + ADC L1 + ASL + ASL + ASL + ASL + ASL + ASL + ADC C1 + STA ADR + + LDA L2 + SEC + SBC L1 + STA DY + LDA C1 + CMP C2 + BCCL ZFDIR +ZFINDIR SBC C2 + STA DX + CMP DY + BCC ZFINDIR3 + BRL ZFINDIR2 + +ZFINDIR3 LDA DY + TAY + LSR + EOR #$FFFF + INC +]LOOP STA UT + LDA ADR + LSR + TAX + BCC ZP_GAU1 + CLC + BRA *+4 + +]LOOP2 STA UT + Plot0 + DEY + BMI ZFIN1 + TXA + ADC #$A0 + TAX + LDA DX + ADC UT + BMI ]LOOP2 + SBC DY + +]LOOP STA UT +ZP_GAU1 = * + Plot1 + DEY + BMI ZFIN1 + TXA + ADC #$A0 + TAX + LDA DX + ADC UT + BMI ]LOOP + SBC DY + DEX + BRL ]LOOP2 +ZFIN1 RTS + +ZFDIR LDA C2 + SEC + SBC C1 + STA DX + CMP DY + BCSL ZFDIR2 +ZFDIR3 LDA DY + TAY + INC + LSR + EOR #$FFFF + INC +]LOOP STA UT + LDA ADR + LSR + TAX + BCC ZP_GAU2 + CLC + BRA *+4 + +]LOOP2 STA UT + Plot0 + DEY + BMI ZFIN2 + TXA + ADC #$A0 + TAX + LDA DX + ADC UT + BMI ]LOOP2 + SBC DY + INX + +]LOOP STA UT +ZP_GAU2 = * + Plot1 + DEY + BMI ZFIN2 + TXA + ADC #$A0 + TAX + LDA DX + ADC UT + BMI ]LOOP + SBC DY + BRL ]LOOP2 +ZFIN2 RTS + +ZFDIR2 LDA DX + TAY + LSR + EOR #$FFFF + INC + STA UT + LDA ADR + LSR + TAX + BCC ZP_GAU4 + CLC + BRA *+4 + +]LOOP2 STA UT + Plot0 + DEY + BMI ZFIN4 + INX + LDA DY + ADC UT + BMI ZP_GAU4-2 + SBC DX + STA UT + TXA + ADC #$A0 + TAX + BRA *+4 + + STA UT +ZP_GAU4 = * + Plot1 + DEY + BMI ZFIN4 + LDA DY + ADC UT + BMIL ]LOOP2 + SBC DX + STA UT + TXA + ADC #$A0 + TAX + BRL ]LOOP2+2 +ZFIN4 RTS + + +ZFINDIR2 LDA DX + TAY + LSR + EOR #$FFFF + INC +]LOOP STA UT + LDA ADR + LSR + TAX + BCC ZP_GAU3 + CLC + BRA *+4 + +]LOOP2 STA UT + Plot0 + DEY + BMI ZFIN3 + LDA DY + ADC UT + BMI ZP_GAU3-2 + SBC DX + STA UT + TXA + ADC #$A0 + TAX + BRA *+4 + + STA UT +ZP_GAU3 = * + Plot1 + DEY + BMI ZFIN3 + DEX + LDA DY + ADC UT + BMIL ]LOOP2 + SBC DX + STA UT + TXA + ADC #$A0 + TAX + BRL ]LOOP2+2 +ZFIN3 RTS + +*================================================= + +* -------------------- * +* Counter de Frame... * +* -------------------- * + +* Position du compteur sur l'ecran + +Adr_Screen = $E12000+$84 ;;;$8A + +* Variable a incrementer a chaque 'cycle' d'animation + +Cmpt_Frame DS 2 + +* Initialisation du compteur + +Init_Counter PHP + REP #$30 + + ldal $E10054 + sta org_patch1 + ldal $E10056 + sta org_patch2 + + HEX A9 + HEX 5C + DFB #Inter_1Sec + DFB #^Inter_1Sec + STAL $E10056 + do 0 + DFB $A9,$5C,Inter_1Sec + LDA #^Inter_1Sec ;;;;/$100 + STAL $E10056 + fin + STZ Cmpt_Second + STZ Cmpt_Frame + LDX #$1E +]lp LDAL $E19E00,X + STAL $E19FE0,X + DEX + DEX + BPL ]lp + LDA #$0400 + STAL $E19FE8 + LDA #$0C00 + STAL $E19FEC + SEP #$30 + LDX #6 + LDA #$0F +]lp STAL $E19D00,X + DEX + BPL ]lp + rep $30 + + ~GetIRQEnable + pla + and #%10000 ; 1 second interrupts - bit 4 + sta OneSecStarted + bne :alreadyOn + + ~IntSource #6 ; enable 1sec +:alreadyOn PLP + RTS + +*------------------------------------------------- +OneSecStarted ds 2 +Cmpt_Second DS 2 +*------------------------------------------------- + +Inter_1Sec PHP + PHB + phd + PHK + PLB + REP #$30 + lda OurDP + tcd + INC Cmpt_Second + LDA Cmpt_Second + CMP #2 + BNE Not_Enough + JSR Show_NbFrame + STZ Cmpt_Second + STZ Cmpt_Frame + lda fps_dir + bne left +right inc fps_offset + lda fps_offset + cmp #14 + blt nochange + sta fps_dir + bra nochange +left dec fps_offset + lda fps_offset + bne nochange + stz fps_dir +nochange +Not_Enough SEP #$20 + ldal $E0C032 + and #%1011_1111 + stal $E0C032 + pld + PLB + PLP + CLC + RTL + +Show_NbFrame SEP #$30 + + LDA #"0" + STA Res+5 + LDA #";" + STA Res+4 + LDA Cmpt_Frame + LSR + BCC No5 + LDX #"5" + STX Res+5 +No5 JSR Convert + REP #$30 + LDX #1 + STZ Pos_Cmpt +]loopaga PHX + LDA Res,X + AND #$00FF + SEC + SBC #$B0 + TAX + LDA Table_Digit,X + AND #$00FF + TAY +* LDX Pos_Cmpt + LDa Pos_Cmpt + clc + adc fps_offset + tax + +]A = 0 + LUP 7 + LDA {]A*2}+Digit,Y + STAL ]A*$A0+Adr_Screen,X + LDA #0 + STAL ]A*$A0+Adr_Screen+2,X +]A = ]A+1 + --^ + LDA Pos_Cmpt + INC + INC + INC + STA Pos_Cmpt + PLX + INX + CPX #6 + BEQ End_LgnCompteur + BRL ]loopaga +End_LgnCompteur RTS + +*------------------------------------------------- + +Pos_Cmpt DS 2 + +Table_Digit DFB 0 + DFB 14 + DFB 14*2 + DFB 14*3 + DFB 14*4 + DFB 14*5 + DFB 14*6 + DFB 14*7 + DFB 14*8 + DFB 14*9 + DFB 14*10 + DFB 14*11 + +*------------------------------------------------- + + MX %11 +Convert = * + + STA VALUE + + LDX #":" ; Led Off + STX Res + +Positif LDX #2 ; Nb de chiffre max en resultat + STX LEAD0 + STZ VALUE+1 + + LDY #1 ; Counter +PRTI1 LDA #":" ; Off + STA Res,Y + + LDA #"0" + STA DIGIT + +PRTI2 SEC + LDA VALUE + SBC TBL_LO,X + PHA + LDA VALUE+1 + SBC TBL_HI,X + BCC PRTI3 + + STA VALUE+1 + PLA + STA VALUE + INC DIGIT + JMP PRTI2 + +PRTI3 PLA + LDA DIGIT + CPX #0 + BEQ PRTI5 + CMP #"0" + BEQ PRTI4 + STA LEAD0 + +PRTI4 BIT LEAD0 + BPL PRTI6 +PRTI5 LDA DIGIT + STA Res,Y +PRTI6 INY + DEX + BPL PRTI1 + RTS + +Res DS 7 + +LEAD0 DS 2 +DIGIT DS 2 +VALUE DS 2 + +OurDP ds 2 + +TBL_LO DFB #1 + DFB #10 + DFB #100 + DFB #1000 + DFB #10000 + +TBL_HI DFB #>1 + DFB #>10 + DFB #>100 + DFB #>1000 + DFB #>10000 + + +Digit HEX 06606006600604406006600606600440 + HEX 40064006044040064006044006604006 + HEX 40060660600460040660066040064006 + HEX 06604006400606600440600660060660 + HEX 40064006044006606004600406604006 + HEX 40060660066060046004066060066006 + HEX 06600660400640060440400640060440 + HEX 06606006600606606006600606600660 + HEX 600660060660400640060660 + + do 0 + HEX 0440 ; Off + HEX 4004 + HEX 4004 + HEX 0440 + HEX 4004 + HEX 4004 + HEX 0440 + fin + + HEX 0000 ; Off + HEX 0000 + HEX 0000 + HEX 0000 + HEX 0000 + HEX 0000 + HEX 0000 + + HEX 0440 ; . + HEX 4004 + HEX 4004 + HEX 0440 + HEX 4004 + HEX 4004 + HEX 0460 + +*------------------------------------------------- + PUT CURVES +Table_Cos = * ; Sur 16bits, 1=$10000 +Table_Sin = *+$800 + PUT TABLE.COS + +Table_11 ds $100 +Table_21 ds $100 +Table_31 ds $100 +Table_12 ds $100 +Table_22 ds $100 +Table_32 ds $100 +Table_13 ds $100 +Table_23 ds $100 +Table_33 ds $100 + LST OFF + +*------------------------------------------------- +MyID ds 2 +WindPtr ds 4 +RezFileID ds 2 +*================================================= + mx %00 +*================================================= +* Hit +* +* handle item hits + +doHit = * + + lda #0 + sta T2Result+2,s + sta T2Result,s + lda T2data2+2,s ; ctlID hi word must be zero + bne :nothingHit + lda T2data2,s ; get ctlID + cmp #FPSCtlID + beq :enable + cmp #DelayPopCtlID + beq :enable + cmp #ShapePopCtlID + beq :enable + cmp #MaxZoomCtlID + beq :enable +:nothingHit brl Bye + +:enable lda #TRUE + sta T2Result,s + bra :nothingHit + +*================================================= +* +* Create all the buttons in the window +* +doMake = * + +* brk $11 + lda T2data1+2,s + sta WindPtr+2 + lda T2data1,s + sta WindPtr + lda T2data2,s + sta RezFileID +* lda T2data2+2,s +* sta MyID + ~MMStartUp + pla + sta MyID + + ~NewControl2 WindPtr;#resourceToResource;#CtlLst + plx + plx + +* make sure setup is loaded.. + + ~GetCurResourceFile + ~SetCurResourceFile RezFileID + jsr load_setup + _SetCurResourceFile + + lda ImpulseFlag + and #fFPSCounter ; fps off/on + pha + ~GetCtlHandleFromID WindPtr;#FPSCtlID + _SetCtlValue + + lda ImpulseFlag + and #fBigShapes ; large shapes off/on + lsr +* eor #1 + pha + ~GetCtlHandleFromID WindPtr;#MaxZoomCtlID + _SetCtlValue + + lda ImpulseFlag + and #$FF00 + xba + pha + ~GetCtlHandleFromID WindPtr;#DelayPopCtlID + _SetCtlValue + + lda ImpulseShapes + pha + ~GetCtlHandleFromID WindPtr;#ShapePopCtlID + _SetCtlValue + + lda #8 + sta T2Result,s + brl Bye + +*================================================= + +* ImpulseFlag: +* (fFPSCounter) bit 0: 0 = fps off (default), 1 = fps on +* (fBigShapes) bit 1: 0 = big shapes off (default), 1 = big shapes on +* bits 8-15: delay. multiply by 10 to turn into seconds + +ImpulseFlag ds 2 + +* ImpulseShape: +* 1 = All +* 2 = random +* else, = shape + 2 (so shape 1 would = 3) + +ImpulseShapes ds 2 + +temp ds 4 + +rImpulseFlag str 'Impulse: Flags' +rImpulseShapes str 'Impulse: Shapes' + +toT2String str 'DYA~Twilight II~' +*================================================= +doLoadSetup = * + +* brk $22 + jsr load_setup + brl Bye + +load_setup = * + +* brk $33 + +* Load the fps/maxzoom/delay resource. + + ~RMLoadNamedResource #rT2ModuleWord;#rImpulseFlag + bcc :flagThere + plx + plx ;setup not saved yet... + lda #$0200 ; 20 second delay, no fps, no large shapes + sta ImpulseFlag + bra :noFlag + +:flagThere + jsr makePdp + lda [3] + sta ImpulseFlag + killLdp + + do rele + PushWord #3 + PushWord #rT2ModuleWord ;rtype for release + ~RMFindNamedResource #rT2ModuleWord;#rImpulseFlag;#temp ;rID + _ReleaseResource + fin + +:noFlag + +* Load the shapes resource. + + ~RMLoadNamedResource #rT2ModuleWord;#rImpulseShapes + bcc :shapesThere + plx + plx ; setup not saved yet... + lda #1 + sta ImpulseShapes ; all shapes + bra :noShapes + +:shapesThere + jsr makePdp + lda [3] + sta ImpulseShapes + killLdp + + do rele + PushWord #3 + PushWord #rT2ModuleWord ;rtype for release + ~RMFindNamedResource #rT2ModuleWord;#rImpulseShapes;#temp ;rID + _ReleaseResource + fin + +:noShapes + rts + +*================================================= +doSave = * + +* brk $44 + ~GetCurResourceFile + ~SetCurResourceFile RezFileID + + do 0 +FPSCtlID = 1 +DelayPopCtlID = 2 +ShapePopCtlID = 3 +MaxZoomCtlID = 8 + fin + +* stz ImpulseFlag + + + wr + ~GetCtlHandleFromID WindPtr;#DelayPopCtlID + _GetCtlValue + pla + xba +* ora ImpulseFlag + sta ImpulseFlag + + + wr + ~GetCtlHandleFromID WindPtr;#FPSCtlID + _GetCtlValue + pla + beq :fpsoff + lda #fFPSCounter + tsb ImpulseFlag + +:fpsoff + wr + ~GetCtlHandleFromID WindPtr;#MaxZoomCtlID + _GetCtlValue + pla + beq :bigoff + lda #fBigShapes + tsb ImpulseFlag + +:bigoff + + + ~RMLoadNamedResource #rT2ModuleWord;#rImpulseFlag + bcc :flagFound + plx + plx + + + lr + PushLong #2 + ~GetCurResourceApp +* PushWord MyID + PushWord #attrNoCross+attrNoSpec + phd + phd + _NewHandle + lda 1,s + sta temp + lda 1+2,s + sta temp+2 + jsr makePdp + lda ImpulseFlag + sta [3] + killLdp + + PushLong temp ; handle + PushWord #attrNoSpec+attrNoCross ; attr + PushWord #rT2ModuleWord ; rtype + ~UniqueResourceID #$FFFF;#rT2ModuleWord ; rID + lda 1,s + sta temp + lda 1+2,s + sta temp+2 + _AddResource + + PushWord #rT2ModuleWord ; rType + PushLong temp ; rID + PushLong #rImpulseFlag ; ptr to name str + _RMSetResourceName + bra :created1 + +:flagFound + jsr makePdp + lda ImpulseFlag + sta [3] + killLdp + + PushWord #TRUE ; changeflag: true + PushWord #rT2ModuleWord ; rtype + ~RMFindNamedResource #rT2ModuleWord;#rImpulseFlag;#temp ; rID + _MarkResourceChange +* _WriteResource + +:created1 + + + + wr + ~GetCtlHandleFromID WindPtr;#ShapePopCtlID + _GetCtlValue + pla + sta ImpulseShapes + + ~RMLoadNamedResource #rT2ModuleWord;#rImpulseShapes + bcc :shapesFound + plx + plx + + lr + PushLong #2 +* PushWord MyID + ~GetCurResourceApp + PushWord #attrNoCross+attrNoSpec + phd + phd + _NewHandle + lda 1,s + sta temp + lda 1+2,s + sta temp+2 + jsr makePdp + lda ImpulseShapes + sta [3] + killLdp + + PushLong temp ; handle + PushWord #attrNoSpec+attrNoCross ; attr + PushWord #rT2ModuleWord ; rtype + ~UniqueResourceID #$FFFF;#rT2ModuleWord ; rID + lda 1,s + sta temp + lda 1+2,s + sta temp+2 + _AddResource + + PushWord #rT2ModuleWord ; rType + PushLong temp ; rID + PushLong #rImpulseShapes ; ptr to name str + _RMSetResourceName + bra :created2 + +:shapesFound + jsr makePdp + lda ImpulseShapes + sta [3] + killLdp + + PushWord #TRUE ; changeflag: true + PushWord #rT2ModuleWord ; rtype + ~RMFindNamedResource #rT2ModuleWord;#rImpulseShapes;#temp ; rID + _MarkResourceChange +* _WriteResource + +:created2 + + + ~UpdateResourceFile RezFileID + _SetCurResourceFile + + brl Bye +*================================================= +init_random = * + +rtlAdr equ 1 +targetStr equ rtlAdr+3 + + lda targetStr+2,s + tax + lda targetStr,s + + PushWord #t2PrivGetProcs + PushWord #stopAfterOne+sendToName + phx + pha + PushLong #8 + PushLong #dataOut + _SendRequest + jsl set_random_seed + + lda 1,s + sta 1+4,s + lda 2,s + sta 2+4,s + plx + plx + rtl + +dataOut + ds 2 +set_random_seed = * + rtl + ds 3 +random = * + rtl + ds 3 +*================================================= +New_Curve = * + + lda ImpulseShapes + cmp #3 + blt :special + sec + sbc #3 +:go asl + tax + lda Curve_Table,x + sta Curve_Adr + jsr Get_Curve ; read/act on shape header + jsr Setup_3d + rts + +:special +* cmp #2 +* beq :random +:all ; shape = 1 = all + +:random ; shape = 2 = random + + jsr do_rnd + bra :go + +do_rnd = * + +:findNew + lr + jsl random + pha + pea 16+1 ; number of shapes + _UDivide + plx + pla ; remainder +* inc a + cmp Cur_Curve + beq :findNew + sta Cur_Curve + rts +*================================================= +* ErrorMaker.. get the appropriate error string into a +* format acceptable by T2. +* +* Accumulator: +* error 1 = Not enough memory. +* error 2 = Shadow screen not available. +* +* Y Register: error code +* +ErrorMaker = * + + dec ;make that 0 through 1 + asl + tax + phx ;save this for a moment + + lr + phy + _HexIt + pla + sta error1 + pla + sta error1+2 + + lda 1,s + tax + + lr + pea 0 + lda Errorlengths,x ;size + pha + lda MyID + ora #$0F00 + pha ;memory ID + PushWord #attrLocked+attrFixed+attrNoCross+attrNoSpec + phd + phd + _NewHandle + PullLong ErrorHand + + plx + pea #^Errors + lda Errors,x + pha ;pointer + PushLong ErrorHand ;handle + pea 0 + lda Errorlengths,x + pha ;size + _PtrToHand ;copy the string into the handle + + lda ErrorHand + sta T2Result,s + lda ErrorHand+2 + sta T2Result+2,s + + brl return + +* errors that can be returned + +ErrorHand adrl 0 + +Errors da memoryErr + da screenErr + +Errorlengths + da screenErr-memoryErr + da endoferrors-screenErr + +memoryErr asc 'Impulse 3-D Fatal Memory Error: $' +error1 asc '????'0D + asc 'Could not allocate 192k continuous free memory.'00 +screenErr asc 'Impulse 3-D Fatal Shadow Error:'0D + asc 'Shadow screen unavailable. Try again later.'00 +endoferrors + +************************************************** + put makepdp.asm + SAV impulse.l + + + do 0 +*------------------------------------------------- + +New_Curve = * + lda Cur_Curve + asl + tax + lda Curve_Table,x + bne not_end + stz Cur_Curve + bra New_Curve +not_end sta Curve_Adr + jsr Get_Curve ; read/act on shape header + jsr Setup_3d + rts + +*------------------------------------------------- + fin diff --git a/source/twilight/rings/makefile b/source/twilight/rings/makefile new file mode 100644 index 0000000..b921f96 --- /dev/null +++ b/source/twilight/rings/makefile @@ -0,0 +1,14 @@ + +# static makefile +# by Jim Maricondo +# v1.0 - 5/23/93 12:39pm - coded. + +rings.r: rings.rez 22/t2common.rez + compile rings.rez keep=rings.r + +rings: rings.r rings.d + duplicate -d rings.d rings + duplicate -r rings.r rings + setfile -at $4004 -t $bc rings -m . + cp rings *:system:cdevs:twilight:rings + 22:beep diff --git a/source/twilight/rings/rings.rez b/source/twilight/rings/rings.rez new file mode 100644 index 0000000..4d7054e --- /dev/null +++ b/source/twilight/rings/rings.rez @@ -0,0 +1,87 @@ + +#include "types.rez" +#include "22:t2common.rez" + +resource rT2ModuleFlags (moduleFlags) { + fGrafPort320+ + fLeavesUsableScreen+ + fFadeIn+ + fFadeOut, // module flags word + $01, // enabled flag (unimplemented) + $0110, // minimum T2 version required + NIL, // reserved + "Rings" // module name +}; + +// --- Version resource + +resource rVersion (moduleVersion) { + {1,0,0,alpha,2}, // Version + verUS, // US Version + "T2 Rings Module", // program's name + "By Chris McKinsey & JRM.\n" // copyright notice + "Copyright 1993-4 DigiSoft Innovations." +}; + +// --- About icon resource + +resource rIcon (moduleIcon) { + $8000, // kind + $0014, // height + $0016, // width + + $"F00000000000000000000F" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0F000000000000000000F0" + $"0F030F0F3F0F0F330F00F0" + $"0F00F00F00303003F330F0" + $"0F0F03F033303F3030F0F0" + $"0F0300030F00F0303300F0" + $"0F0030F303330F303F30F0" + $"0F0F3F03F00F0303F0F0F0" + $"0F0300F00003F3030300F0" + $"0F00F330FF033F0FF030F0" + $"0F000000000000000000F0" + $"0FFFFFFFFFFFFFFFFAFFF0" + $"0000000000000000000000" + $"F0FFFFFFFFFFFFFFFFFF0F" + $"F0FFFFFFFFFFFFFFFFFF0F" + $"F0FF4AFFFFFFFFFFFFFF0F" + $"F0CCCCCCCCCCCCCCCCCC0F" + $"F0FFFFFFFFFFFFFFFAFF0F" + $"F00000000000000000000F", + + $"0FFFFFFFFFFFFFFFFFFFF0" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0FFFFFFFFFFFFFFFFFFFF0"; +}; + +// --- rTextForLETextBox2 Templates + +resource rTextForLETextBox2 (moduleMessage) { + TBFont TBShaston "\$00\$08" + TBLeftJust + TBBackColor TBColorF + TBForeColor TBColor1 + TBStyleBold "Rings" + TBForeColor TBColor0 + TBStylePlain + " is cool!" +}; diff --git a/source/twilight/rings/rings.s b/source/twilight/rings/rings.s new file mode 100644 index 0000000..cf2b38b --- /dev/null +++ b/source/twilight/rings/rings.s @@ -0,0 +1,515 @@ +************************************************** +* Rings Demo * +* By Christopher Martin McKinsey * +* Started: December 20, 1991 * +************************************************** + cas in + mx %00 + rel + use macros + + ext MultAX,ShadowOn,ShadowOff,MakeMask,getmem,deref + ext showcell,loadcells,loadcellspal,readbeam,error + ext gosubHand,erasebob + + put t2common.equ + +Height = $08 +Width = Height+4 +YLoc = Width+4 +XLoc = YLoc+2 +YVel = XLoc+2 +XVel = YVel+2 +Mask = XVel+2 +Image = Mask+4 +ImgNum = Image+4 +Work_Ptr = ImgNum+2 +cellRefPtr = Work_Ptr+4 +MovePtr = $80 + +rowBytes = 160 +pixsHigh = 200 +Left_Arrow = $08 +Right_Arrow = $15 + +not = 0 + +*------------------------------------------------- + dum 1 +* dp da 0 +Bank db 0 ;This is how the stack is set up +rtlAddr adr 0 ;with DP at the top and Result +T2data2 adrl 0 ;occupying the top four bytes +T2data1 adrl 0 +T2Message da 0 +T2Result adrl 0 +T2StackSize adrl 0 + dend +*------------------------------------------------- + +Rings_T2 = * + phb + phk + plb + tdc + sta OurDP + + do not + brk 00 + fin + + sep #$30 + ldal $E1C035 + rep #$30 + bit #$08 + bne bad + + lda T2Message,s + cmp #BlankT2 + beq doBlank + + do 0 + cmp #MakeT2 + beql doMake + cmp #HitT2 + beql doHit +* cmp #KillT2 +* beql doKill + cmp #SaveT2 + beql doSave + cmp #LoadSetupT2 + beql doLoadSetup +* cmp #UnloadSetupT2 +* beql doUnloadSetup + fin + +bad brl Bye + +*------------------------------------------------- +doBlank = * + LDX #$FE ; init our DP +]lp STZ $00,X + DEX + DEX + BPL ]lp + + lda T2data1,s + sta MovePtr ;save this in our own DP + lda T2data1+2,s + sta MovePtr+2 + + ~MMStartUp + pla + ora #$0100 + sta MyID + sta My_ID + + pea 0 + pea 0 + pea 0 + pea #160 + pea #200 + jsl shadowon + jsl eraseBob + jsl shadowoff + + do 0 + ldx #768+32-2 + lda #$00 +]l stal $E19D00,x + dex + dex + bpl ]l + fin + +* +* load in the cells +* + phl #cells + jsl loadcells + bcsl return + stx cellRefPtr + sty cellRefPtr+2 + + lda [cellRefPtr] + sta numFrames + + txa + clc + adc #$02 + sta cellRefPtr + tya + adc #$00 + sta cellRefPtr+2 + + ldx #$20-2 +]l lda loadcellspal,x + stal $E19E00,x + dex + dex + bpl ]l + + jsr init + do not + brk 01 + fin + +]l + jsr Animate + lda [MovePtr] + beq ]l + + jsl shadowon + + do 0 + ldal $e0c000 + bpl ]l + stal $e0c010 + and #$007f + cmp #Right_Arrow + bne :1 + lda numactors + cmp #10 + beq ]l + inc numactors + bra ]l +:1 cmp #Left_Arrow + bne :2 + lda numactors + cmp #$01 + beq ]l + dec numactors + bra ]l +:2 + fin + +return + ~DisposeAll MyID + + do 0 + lda MyID + and #$F0FF + pha + _MMShutDown + fin + +Bye = * +skip = * + plb + lda 1,s ; move up RTL address + sta 1+10,s + lda 2,s + sta 2+10,s + tsc ; Remove input parameters. + clc + adc #10 + tcs + clc + rtl + +************************************************** +* This is a GLOBAL data area for the program * +************************************************** +errorMsg str 'Error loading Rings Demo.' + +My_ID ent + ds 2 +oldSP ds 2 +backcolor ds 2 + +cells strl '*:system:cdevs:twilight:Cells' +frame dw 0 +numFrames dw 0 + +MaxActors = 10 ; 20 +cellxvel ds 2*MaxActors +cellyvel ds 2*MaxActors +cellxloc ds 2*MaxActors +cellyloc ds 2*MaxActors + +NumActors dw MaxActors +origxvel dw +1,+2,+3,+4,+5,+6,+7,+8,+9,+10 +origyvel dw +5,+4,+3,+2,+1,+5,+4,+3,+2,+1 + +*================================================= +MyID ds 2 +OurDP ds 2 +*================================================= +************************************************** +* Routine to test multiple animations * +************************************************** +Animate + jsr Move + jsr Draw + jsl shadowon + jsr Show + jsl shadowoff + jsr Erase + + inc frame + lda frame + cmp numFrames + bne :X + stz frame +:X rts +************************************************** +* * +************************************************** +Move + lda numActors + sta :lup + ldx #$00 +]l + lda frame + asl + asl + asl + tay + + lda #rowBytes + sec + sbc [cellRefPtr],y ;frame byte width + asl + sta 0 + + lda cellxloc,x + clc + adc cellxvel,x + cmp 0 + blt :Do_Y + + lda #$00 + sec + sbc cellxvel,x + sta cellxvel,x + clc + adc cellxloc,x +:Do_Y + sta cellxloc,x + + iny + iny + lda #pixsHigh + sec + sbc [cellRefPtr],y ;frame height + sta 0 + + lda cellyloc,x + clc + adc cellyvel,x + cmp 0 + blt :Do_Next + + lda #$00 + sec + sbc cellyvel,x + sta cellyvel,x + clc + adc cellyloc,x +:Do_Next + sta cellyloc,x + + inx + inx + dec :lup + bne ]l + rts +:lup dw 0 +************************************************** +* Draw the shape * +************************************************** +Draw + stz ImgNum +]l + lda frame + asl + asl + asl + clc + adc #$04 + tay + lda [cellRefPtr],y + pha + iny + iny + lda [cellRefPtr],y + pha + + lda ImgNum + asl + tax + lda cellyloc-1,x + lsr + lsr + adc cellyloc-1,x + adc cellxloc,x + lsr + clc + adc #$2000 + ply + plx + jsl gosubHand + + inc ImgNum + lda ImgNum + cmp NumActors + blt ]l + rts +************************************************** +* Show the shapes to the screen * +************************************************** +Show + stz imgnum +]l + lda imgnum + asl + tax + mvw cellxloc,x;xloc + mvw cellyloc,x;yloc + mvw cellxvel,x;xvel + mvw cellyvel,x;yvel + + lda frame + asl + asl + asl + tay + lda [cellRefPtr],y + sta width + iny + iny + lda [cellRefPtr],y + sta height + + jsr Show_Image + inc imgnum + lda imgnum + cmp NumActors + blt ]l + rts +************************************************** +* Erase the shapes * +************************************************** +Erase + stz ImgNum +]l + lda backcolor + pha + lda ImgNum + asl + tax + lda cellxloc,x + pha + lda cellyloc,x + pha + lda frame + asl + asl + asl + tay + lda [cellRefPtr],y + pha + iny + iny + lda [cellRefPtr],y + pha + jsl eraseBob + + inc ImgNum + lda ImgNum + cmp NumActors + blt ]l + rts +************************************************** +* init x and y locs, plus vels * +************************************************** +init + stz frame + + lda #160 + sec + sbc [cellRefPtr] + sta 0 + + ldy #$02 + lda [cellRefPtr],y + lsr + sta 2 + lda #100 + sec + sbc 2 + sta 2 + + ldx #$00 + ldy NumActors +]l lda origxvel,x + sta cellxvel,x + lda origyvel,x + sta cellyvel,x + lda 0 + sta cellxloc,x + lda 2 + sta cellyloc,x + inx + inx + dey + bne ]l + rts +************************************************** +* Show the image here * +************************************************** +Show_Image ent + + ldx Xvel + txa + lsr + bcc :Even + txa + bmi :neg + inx + bra :Even +:neg dex +:Even stx XVel + + lda XVel + beq :Check_Y + bpl :Right + +:Left sub Width;XVel;Width + bra :Check_Y + +:Right lda Xloc + sec + sbc XVel + cmp #320 + blt :rok + lda #0 +:rok sta Xloc + add XVel;Width + +:Check_Y + lda YVel + beq :Show_It + bpl :Down + +:Up sub Height;YVel;Height + bra :Show_It + +:Down lda YLoc + sec + sbc YVel + cmp #200 + blt :dok + lda #0 +:dok sta Yloc + add YVel;Height + +:Show_It + pei xloc + pei yloc + pei width + pei height + jsl showcell + rts +************************************************** + sav Rings.l diff --git a/source/twilight/rings/t2common.equ.s b/source/twilight/rings/t2common.equ.s new file mode 100644 index 0000000..44affc0 --- /dev/null +++ b/source/twilight/rings/t2common.equ.s @@ -0,0 +1,88 @@ + +* T2 Common Module Equates. By Jim Maricondo. +* v1.0 - 05/24/92 - Initial Version. +* v1.1 - 05/29/92 - Revised 'cuz of new t2common.rez. - v1.0d33 +* v1.2 - 10/24/92 - IPC equates added - v1.0.1b1. - datafield added +* v1.3 - 12/13/92 - mfOverrideSound added - v1.0.1b2 + +* Resources types. + +rT2ModuleFlags equ $1000 +rT2ExtSetup1 equ $1001 +rT2ModuleWord equ $1002 ; reztype for module words in T2 setup + +* Action message codes sent to modules. + +MakeT2 equ 0 ; Make module-specific ctls. +SaveT2 equ 1 ; Save new preferences +BlankT2 equ 2 ; Blank the screen. +LoadSetupT2 equ 3 ; Load any resources from yo' fork +UnloadSetupT2 equ 4 ; Dispose of any resources from yo' fk. +KillT2 equ 5 ; Module setup being closed. +HitT2 equ 6 ; Setup window control hit. + + do 0 +* How the stack is setup when a module gets called. + +dp equ 1 ; This is how the stack is set up +Bank equ dp+2 ; with DP at the top and Result +rtlAddr equ Bank+1 ; occuping the top 4 bytes +T2data2 equ rtlAddr+3 +T2data1 equ T2data2+4 +T2Message equ T2data1+4 +T2Result equ T2Message+2 +T2StackSize equ T2Result+4 + +* Softswitches + +KBD equ >$E0C000 +KBDSTRB equ >$E0C010 +RDVBLBAR equ >$E0C019 ; bit 7 = 1 if not VBL +TBCOLOR equ >$E0C022 +NEWVIDEO equ >$E0C029 +VERTCNT equ >$E0C02E +SPKR equ >$E0C030 +CLOCKCTL equ >$E0C034 ; border color / rtc register +SHADOW equ >$E0C035 +INCBUSYFLG equ >$E10064 ; increment busy flag +DECBUSYFLG equ >$E10068 ; decrement busy flag +SHR equ >$E12000 +SCBS equ >$E19D00 +PALETTES equ >$E19E00 + + fin + +* Boolean logic + +FALSE equ 0 +TRUE equ 1 + +* T2 External IPC + +t2TurnOn equ $9000 +t2TurnOff equ $9001 +t2BoxOverrideOff equ $9002 +t2BoxOverrideOn equ $9003 +t2GetCurState equ $9004 +t2StartupTools equ $9005 +t2ShutdownTools equ $9006 +t2ShareWord equ $9007 +t2SetBlinkProc equ $9008 +t2GetNoBlankCursors equ $9009 +t2BkgBlankNow equ $900A +t2GetBuffers equ $900B +t2GetVersion equ $900C + +* T2 Private IPC + +reqDLZSS equ $8007 +t2PrivGetProcs equ $9020 + +* DataField equates. + +SetFieldValue equ $8000 ;custom control messages that are +GetFieldValue equ $8001 ; accepted by DataField + +* Flag word passed to modules at loadsetupT2 time... + +mfOverrideSound equ $0001 ; bit 0. 1=override sound, 0=sound ok diff --git a/source/twilight/sample/ball.cc b/source/twilight/sample/ball.cc new file mode 100644 index 0000000..f7f6f4d --- /dev/null +++ b/source/twilight/sample/ball.cc @@ -0,0 +1,503 @@ + +/* +** Ball, Release v1.0 - 19 July 1993. +** Initial release for KansasFest '93. +** Release v1.1 - 8 July 1994. +** Sound routine oversights fixed and other misc. improvements. +** +** C Source Code - "ball.cc" - Main Source Segment (4 spaces = 1 tab) +** +** A Twilight II module by James C Smith and James R Maricondo. +** Parts based off the original T2 C shell by Josef Wankerl. +** Nothing fancy, this is mainly for demo/example purposes only! +** +** Copyright 1993-94 DigiSoft Innovations, All Rights Reserved. +** +** Permission granted to use this source in any module designed for +** Twilight II for the Apple IIGS. +*/ + +/* pragmas */ + +#pragma keep "Ball.d" +#pragma cdev Ball +#pragma optimize -1 +#pragma debug 0 + +/* defines */ + +#define ballCtlList 1l + +#define RedStr 1l +#define BlueStr 2l +#define GreenStr 3l +#define PurpleStr 4l +#define YellowStr 5l +#define TurquoiseStr 6l +#define ballColorStr 10l +#define useSoundStr 20l + +#define colorMenu 1l + +#define colorCtl 1l +#define useSoundCtl 2l +#define ballStrCtl 3l +#define ballIconCtl 4l +#define ballLineCtl 5l + +#define blueMenuItem 1l +#define greenMenuItem 2l +#define redMenuItem 3l +#define turquoiseMenuItem 4l +#define purpleMenuItem 5l +#define yellowMenuItem 6l + +typedef struct rSoundSampleType { + int SoundFormat; + int WaveSize; + int RealPitch; + int StereoChannel; + unsigned int SampleRate; + char StartOfWaveData; +}; + + +/* includes */ + +#include "T2.h" /* include the C twilight II header file */ +#include +#include +#include +#include /* for toolerror only */ +#include +#include +#include +#include +#include /* for SysBeep only */ + +#pragma lint -1 + + +/* prototypes */ + +LongWord Ball(LongWord, LongWord, Word); +LongWord MakeT2Ball(void); +void LoadSetupT2Ball(void); +void SaveConfigResource(char *, Word); +Word LoadConfigResource(char *, Word); +LongWord HitT2Ball(LongWord); +void SaveT2Ball(void); +void make_palette(int, Word *); +handle LoadASound(unsigned long ResID, word *); +void PlayASound(handle, int, word); +void cycle(void); + + +/* globals */ + +Word MyID; /* our memory manager ID */ +Word soundStatus; /* boolean: old status of sound tool */ + +char *ConfigNameString="\pBall Setup"; /* rName to save config data under */ + +unsigned int BallColor, SoundFlag; +Word *movePtr; /* TRUE when we should exit the module */ + +Word SetupFileNumber; +GrafPortPtr SetupWindow; + +Long X,Y,XV,YV, BallSize, GravityValue; +Rect MyRect; +Word MyColorTable[16]; + +Handle SoundHandleBoing; /* handle to the boing rSound */ +Word BoingFreq; /* (converted) frequency of boing */ +struct rSoundSampleType *SoundPtr; +Word LastGen, GenNum=0; +struct SoundParamBlock SoundPB; + +/* this is the structure that allows us to have T2 convert the rSound header + frequency to a frequency we can pass to FFStartSound */ +struct freqOffsetOut FreqOut; + + +/* other source files */ + +#include "config.cc" + + +/* main functions */ + +/* +** BlankT2 message handler: Do the animation! +*/ + +LongWord BlankT2Ball(void) { + + unsigned int temp; + int color = 0; + int bounce = 0; + int cycleIt = 0; + + struct startupToolsOut ballToolsOut; + Ptr ballToolsOutP = (Ptr) &ballToolsOut; + +/* Start the sound tools if we need to */ +/* Note that ball will only use sound if WE start the sound tools ourselves. + If they were started by someone else, it's not safe to use them. */ + + soundStatus = SoundToolStatus(); + if (!soundStatus) { + SendRequest(t2StartupTools, stopAfterOne+sendToName, (long) toT2Str, + (long) (((long) MyID<<16) + startshut_sound), + (Ptr) ballToolsOutP); + if (ballToolsOut.errors) { /* if error starting up, bail out! */ + SysBeep(); + return (LongWord) NULL; + } + } + + make_palette(BallColor, &MyColorTable[0]); + SetColorTable(0, MyColorTable); + + BallSize=10; + GravityValue=8000; + X=100<<16; + Y=15<<16; + XV=4<<16; + YV=0; + SetPenMode(modeCopy); + + while (!(*movePtr)) { /* until MovePtr is true, do it! */ + YV+=GravityValue; /* increase gravity */ + X+=XV; /* update x velocity */ + Y+=YV; /* update y velocity */ + if( (X+BallSize > (320<<16)) | (X-BallSize<0) ) { + XV=-XV; /* bounce off the sides */ + if (X+BallSize > (320<<16)) /* boing! */ + PlayASound(SoundHandleBoing, 0, BoingFreq); /* right boing */ + else PlayASound(SoundHandleBoing, 1, BoingFreq);/* left boing */ + } + if( (Y+BallSize > (200<<16)) | (Y-BallSize<0) ) { + YV=-YV; /* bounce off the bottom */ + bounce++; /* increment bottom bounce counter */ + } + + MyRect.v1=(Y>>16)-BallSize; /* move the ball! */ + MyRect.h1=(X>>16)-BallSize; + MyRect.v2=(Y>>16)+BallSize; + MyRect.h2=(X>>16)+BallSize; + + color = (color+1)&0xF; + if (!color) color = 1; /* no black! */ + SetSolidPenPat(color); /* draw the ball! */ + PaintOval(&MyRect); + + if (((++cycleIt)&3)==0) /* cycle every 4th time */ + cycle(); + + if (bounce > 30) { /* restart from beginning */ + GravityValue=8000; + X=X>>1; + Y=15<<16; + XV=4<<16; + YV=0; + bounce = 0; + ClearScreen(0); + } + + } + +/* Shutdown the sound tools if we started them... */ + + if (!soundStatus) + SendRequest(t2ShutdownTools, stopAfterOne+sendToName, (long) toT2Str, + (long) startshut_sound, + (long) NULL); + +/* No error occurred, so return a NULL handle */ + + return (LongWord) NULL; +} + + + +/* +** cycle - do the color cycling - quick and dirty assembly +*/ + +void cycle(void) { + + Word temp; + + asm { + lda 0xe19e02 + sta temp + lda 0xe19e04 + sta 0xe19e02 + lda 0xe19e06 + sta 0xe19e04 + lda 0xe19e08 + sta 0xe19e06 + lda 0xe19e0a + sta 0xe19e08 + lda 0xe19e0c + sta 0xe19e0a + lda 0xe19e0e + sta 0xe19e0c + lda 0xe19e10 + sta 0xe19e0e + lda 0xe19e12 + sta 0xe19e10 + lda 0xe19e14 + sta 0xe19e12 + lda 0xe19e16 + sta 0xe19e14 + lda 0xe19e18 + sta 0xe19e16 + lda 0xe19e1a + sta 0xe19e18 + lda 0xe19e1c + sta 0xe19e1a + lda 0xe19e1e + sta 0xe19e1c + lda temp + sta 0xe19e1e + }; +} + + + +/* +** make_palette-given a color like $100 or $110, create a whole gradient +** palette - e.g. $100, $200, ... $F00; or $110, $220 .. $FF0, etc +*/ + +void make_palette(int base, Word * palette) { + + Word color = base; + int i; + + *palette = 0; + for (i = 1; i<=15; i++) { + palette++; + *palette = color; + color += base; + } +} + + + +/* +** SaveT2 message handler: Save our configuration to disk +*/ + +void SaveT2Ball(void) { + + Word OptionWord; + Word FileNumber; + +/* Save current resource file and switch in Twilight.Setup */ + + FileNumber = GetCurResourceFile (); + SetCurResourceFile (SetupFileNumber); + +/* Get control values */ + + BallColor = GetCtlValue (GetCtlHandleFromID (SetupWindow, colorCtl)); + SoundFlag = GetCtlValue (GetCtlHandleFromID (SetupWindow, useSoundCtl)); + +/* combine them to our 2 byte option word format */ + + OptionWord = BallColor; + + if (SoundFlag) + OptionWord |= 0x8000; + +/* Save control values */ + + SaveConfigResource(ConfigNameString, OptionWord); + +/* Restore old resource file */ + + SetCurResourceFile (FileNumber); +} + + + +/* +** HitT2 message handler: enable save when the popup or check box have been +** changed +*/ + +LongWord HitT2Ball(LongWord ControlHit) { + + LongWord EnableFlag = 0L; + + if (ControlHit == 1 || ControlHit == 2) + EnableFlag = 1L; + + return EnableFlag; +} + + + +/* +** MakeT2 message handler: make our setup controls and set them to their +** last saved or default values +*/ + +LongWord MakeT2Ball(void) { + + Word FileNumber; + + FileNumber = GetCurResourceFile (); + SetCurResourceFile(SetupFileNumber); + LoadSetupT2Ball(); + SetCurResourceFile(FileNumber); + NewControl2(SetupWindow, resourceToResource, (long) ballCtlList); + SetCtlValue(BallColor, GetCtlHandleFromID (SetupWindow, colorCtl)); + SetCtlValue(SoundFlag, GetCtlHandleFromID (SetupWindow, useSoundCtl)); + + return 5L; /* tell T2 we just made 5 controls with ids from 1 thru 5 */ +} + + + +/* +** LoadSetupT2 message handler: load the last saved setup values from the +** Twilight.Setup file on disk +*/ + +void LoadSetupT2Ball(void) { + + Word OptionWord; + +/* Option Word format + * 0x0FFF = ball color, in a format that can be passed to make_palette + * (above) - also the menu item ID of the currently selected + * color + * 0x8000 = (bit 15) boolean - 1=use sound, 2=no sound + */ + + OptionWord = LoadConfigResource (ConfigNameString, 0x8110); + BallColor = OptionWord & 0x0FFF; + SoundFlag = OptionWord & 0x8000; +} + + + + +/* +** LoadASound - load an rSound from our resource fork and use a T2 IPC +** request to have T2 convert the rSound header frequency to +** a frequency we can use with FFStartSound +** +** NOTE that our resource fork must be opened beforehand!!! +*/ + +handle LoadASound(unsigned long ResID, word *freqOffset) { + + handle WorkHandle; + + WorkHandle=LoadResource(rSoundSample, ResID); + if(toolerror()) + return 0; + DetachResource(rSoundSample, ResID); + SetHandleID(MyID, WorkHandle); + HLock(WorkHandle); + SoundPtr=(void *) *WorkHandle; + SendRequest(t2CalcFreqOffset, stopAfterOne+sendToName, (longword) toT2Str, + (long) (SoundPtr->RealPitch),(void *) &FreqOut); + *freqOffset=FreqOut.freqOffset; + HUnlock(WorkHandle); + return WorkHandle; +} + + + +/* +** PlayASound - play a sound effect. Note that this routine only uses a +** maximum of 2 oscillators (you can change it :-) +*/ + +void PlayASound(handle SoundHandle, int Channel, word Frequency) { + +/* there are three cases where we will not have sound: + 1) the global sound override flag is set (in Setup: Options) + 2) the use sound checkbox is unchecked (in Ball's own options screen) + 3) the sound manager was already started when we were called (e.g. we + didn't have to start it ourselves). in this case, it's not safe to use + sound effects +*/ + + if((!SoundFlag)||(soundStatus)) /* are we supposed to have sound FX? */ + return; + + HLock(SoundHandle); + SoundPtr=(void *) *SoundHandle; + + SoundPB.waveStart=&SoundPtr->StartOfWaveData; + SoundPB.waveSize=SoundPtr->WaveSize; + SoundPB.freqOffset=Frequency; + SoundPB.docBuffer=GenNum<<15; + SoundPB.bufferSize=0x6; + SoundPB.nextWavePtr=NULL; + SoundPB.volSetting=255; + FFStopSound((word) (1<<(GenNum&1))); /* stop anything from earlier */ + FFStartSound((word) (Channel<<12 | ((GenNum&1)<<8) | ffSynthMode), + (Pointer) &SoundPB); + ++GenNum; /* use a different generator next time */ + HUnlock(SoundHandle); +} + + + +/* +** The Main Message Handler! This dispatches the appropriate handler! +*/ + +LongWord Ball(LongWord data2, LongWord data1, Word message) { + + LongWord Result = 1L; + word MyResFile, OldResFile; + + MyID=MMStartUp(); /* get our memory ID for the procs to use */ + switch (message) { + case MakeT2: /* draw and set our setup controls */ + SetupWindow = (GrafPortPtr) data1; + SetupFileNumber = (Word) data2; + Result = MakeT2Ball(); + break; + case BlankT2: /* blank the screen */ + movePtr=(Word *) data1; + Result = BlankT2Ball(); + break; + case SaveT2: /* save the setup */ + SaveT2Ball(); + break; + case LoadSetupT2: /* load the setup */ + LoadSetupT2Ball(); /* first actually load it then load sound */ + if ((int)data2&lmiOverrideSound==lmiOverrideSound) + SoundFlag=0; /* respect global sound override flag */ + if (SoundFlag) { /* load the rSound! */ + OldResFile=GetCurResourceFile(); /* open our rfork! */ + MyResFile=OpenResourceFile(1 /* read only */, + NULL, LGetPathname2(MyID, 0x0001)); + SoundHandleBoing= LoadASound(1, &BoingFreq); + CloseResourceFile(MyResFile); /* close our rfork */ + SetCurResourceFile(OldResFile); /* restore old resfile */ + } + break; + case HitT2: /* handle control hit */ + Result = HitT2Ball(data2); + break; + case UnloadSetupT2: /* unload our setup */ + if (SoundFlag) /* dispose the sound, if loaded */ + DisposeHandle(SoundHandleBoing); + break; + case KillT2: /* don't do anything special for KillT2 */ + break; + } + return Result; +} \ No newline at end of file diff --git a/source/twilight/sample/ball.info b/source/twilight/sample/ball.info new file mode 100644 index 0000000..699d65c --- /dev/null +++ b/source/twilight/sample/ball.info @@ -0,0 +1,59 @@ + +Well, here it is, the first of the long awaited Twilight II sample +source code files! + +This is a very simple module.. Preferably the "use sound" checkbox +should be a popup or something that allows the user to set the sound +volume. This module could be elaborated on in many ways - feel free to +try it! :-) + +Included here, part of Ball (C version), are 13 files: + +ball.info - this information file +ball.rez - the resources for the ball module (Rez source code) +ball.cc - the ball module source (C source code) +config.cc - more ball module source (C source code) +makefile - a makefile to put the whole thing together +rSound.bin - the "boing" sound (a binary image of the rSound) +ball - a compiled version of the ball module (ready to run!) +ball.d - a compiled version of the ball module's data fork +ball.r - a compiled version of the ball module's resource fork +t2.h - Twilight II specific C header information (C header file) +t2common.equ - Twilight II specific assembly header information (not used by ball, but here for your uses) +t2common.rez - Twilight II specific Rez header information (Rez header file) +blank.template - the resource fork of blank.template contains a copy of the Twilight II setup window, so you can layout your setup screen controls graphically with Genesys and then save them to Rez source and fine-tune them manually (NOTE: You cannot use Genesys exclusively to create a Twilight II module's resource fork, because Genesys cannot create the rT2ModuleFlags resource required, and Genesys will not properly set your control IDs to the sequential format T2 requires) + +NOTE: Rez and Orca/C are currently required. + +Version 1.0: July 19, 1993 +Version 1.1: July 8, 1994 + +--- +Also included currently in the Twilight II v1.1 Developer Kit, but +available separately, is the Twilight II Generation 2 Module Format +(G2MF) Reference. This AWGS file documents every aspect of the module +format in detail. You NEED THIS FILE too if you plan on writing +Twilight II modules. You can get it from the same place where you +got Ball! If you can't find it, email us below. + +Coming SOON: + + - Other language versions of the Ball module. + - Better documentation of the Twilight II IPC requests that modules can use! + +Feel free to use all source here to develop Twilight II modules. All +other uses are prohibited. All developer kit files are Copyright Jim +Maricondo, All Rights Reserved. + +For more information on Twilight II, contact: + + DigiSoft Innovations + P.O. Box 380 + Trumbull, CT 06611-0380 + + Phone 203.375.0837 + + Email: digisoft@aol.com (intenet), DIGISOFT (GEnie), DigiSoft (AO), + DYAJIM (Delphi) + +Twilight II is also sold by Big Red Computer Club and Resource Central. diff --git a/source/twilight/sample/ball.rez b/source/twilight/sample/ball.rez new file mode 100644 index 0000000..17fb3f3 --- /dev/null +++ b/source/twilight/sample/ball.rez @@ -0,0 +1,317 @@ + +/* +** Ball, Release v1.1 - 8 July 1994 +** Rez Source Code - "ball.rez" - Rez Code +** +** Much of this code generated with Foundation & Genesys. +** If you don't have Foundation, BUY IT NOW! +** It's invaluable (and necessary) for programming the GS. +** +** Copyright 1993-94 DigiSoft Innovations, All Rights Reserved. +** +** Permission granted to use this source in any module designed for +** Twilight II for the Apple IIGS. +*/ + +#include "types.rez" +#include "T2Common.Rez" // Include Twilight II rez header file + +#define ballCtlList 1 + +#define RedStr 1 +#define BlueStr 2 +#define GreenStr 3 +#define PurpleStr 4 +#define YellowStr 5 +#define TurquoiseStr 6 +#define ballColorStr 10 +#define useSoundStr 20 + +#define colorMenu 1 + +#define colorCtl 1 +#define useSoundCtl 2 +#define ballStrCtl 3 +#define ballIconCtl 4 +#define ballLineCtl 5 + +#define blueMenuItem 1 +#define greenMenuItem 2 +#define redMenuItem 3 +#define turquoiseMenuItem 4 +#define purpleMenuItem 5 +#define yellowMenuItem 6 + +// --- Twilight II module flags resource + +resource rT2ModuleFlags (moduleFlags) { + fSetup + // we support setup + fFadeOut + // we want the screen to be faded out beforehand + fFadeIn + // we want the screen to fade in at the end + fLeavesUsableScreen + // we leave a "usable" screen (see G2MF) + fGrafPort320, // module flags + $01, // enabled flag (unimplemented right now) + $0110, // minimum T2 version required - v1.1 minimum + NIL, // reserved + "Ball" // module name +}; + +// --- rVersion Templates + +resource rVersion (moduleVersion) { + {1,1,0,release,0}, // Version 1.1 release + verUS, // US Version + "T2 Ball (Sample) Module", // program's name + "By Jim Maricondo\n" + "Copyright 1993-94, Jim Maricondo." // copyright notice +}; + +// --- Ball Icon Definition + +resource rIcon (moduleIcon) { + $8000, // kind + $0014, // height + $0016, // width + + $"F00000000000000000000F" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0F044000000000000000F0" + $"0F444400000DDD000000F0" + $"0F44770000DDDDD00000F0" + $"0F0777700ADDDDD00000F0" + $"0F077660BBDDDDD00000F0" + $"0F00666BBBBDDD030000F0" + $"0F0066EBBBB003000000F0" + $"0F000EEEBB0000330000F0" + $"0F000EEEE00000300000F0" + $"0F0000EE000000033000F0" + $"0FFFFFFFFFFFFFFFFAFFF0" + $"0000000000000000000000" + $"F0FFFFFFFFFFFFFFFFFF0F" + $"F0FFFFFFFFFFFFFFFFFF0F" + $"F0FF4AFFFFFFFFFFFFFF0F" + $"F0CCCCCCCCCCCCCCCCCC0F" + $"F0FFFFFFFFFFFFFFFAFF0F" + $"F00000000000000000000F", + + $"0FFFFFFFFFFFFFFFFFFFF0" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"FFFFFFFFFFFFFFFFFFFFFF" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0FFFFFFFFFFFFFFFFFFFF0" + $"0FFFFFFFFFFFFFFFFFFFF0"; +}; + +// module message + +resource rTextForLETextBox2 (moduleMessage) { + TBLeftJust + TBBackColor TBColorF + TBForeColor TBColor1 + "Ball" + TBForeColor TBColor0 + " demonstrates how to write a Twilight II module.\n" + "Full source code available!" +}; + +// --- Ball Control List Definition + +resource rControlList (ballCtlList) { + { + colorCtl, + useSoundCtl, + ballStrCtl, + ballIconCtl, + ballLineCtl, + }; +}; + +// --- Control Templates +// NOTE: IDs _must_ be numbered sequentially from 1..maximumID + +resource rControlTemplate (colorCtl) { + 1, // ID + { 61, 74, 0, 0}, // rect + popUpControl {{ + $0040, // flag + $1002, // moreFlags + NIL, // refCon + NIL, // titleWidth + colorMenu, // menuRef + $01FF, // initialValue + NIL // colorTableRef + }}; +}; + +resource rControlTemplate (useSoundCtl) { + 2, // ID + { 75, 78, 84,188}, // rect + checkControl {{ + NIL, // flag + fCtlProcNotPtr+fCtlWantsEvents+refIsResource, // moreFlags + NIL, // refCon + UseSoundStr, // titleRef + NIL, // initialValue + 0, // colorTableRef + {"U","u",$0100,$0100} // key equivalents + }}; +}; + +resource rControlTemplate (ballStrCtl) { + 3, // ID + { 49,114, 59,209}, // rect + statTextControl {{ + NIL, // flag + $1002, // moreFlags + NIL, // refCon + 1 // textRef (rLeTextBox2) + }}; +}; + +resource rControlTemplate (ballIconCtl) { + 4, // ID + { 26,138, 49,186}, // rect + iconButtonControl {{ + $000C, // flag + $1020, // moreFlags + NIL, // refCon + moduleIcon, // iconRef + NIL, // titleRef + NIL, // colorTableRef + NIL // displayMode + }}; +}; + +resource rControlTemplate (ballLineCtl) { + 5, // ID + { 53, 60, 92,274}, // rect + rectangleControl {{ + $FF02, // flag (%10 = black pattern) + fCtlProcNotPtr, // moreFlags (required values) + NIL // refCon + }}; +}; + + +// --- rPString Templates + +resource rPString (UseSoundStr) { + "Use Sound" +}; + +resource rPString (ballColorStr) { + " Ball Color: " +}; + +resource rPString (RedStr) { + "Red" +}; + +resource rPString (BlueStr, $C018) { + "Blue" +}; + +resource rPString (GreenStr, $C018) { + "Green" +}; + +resource rPString (PurpleStr, $C018) { + "Purple" +}; + +resource rPString (YellowStr, $C018) { + "Yellow" +}; + +resource rPString (TurquoiseStr, $C018) { + "Turquoise" +}; + +// --- Menu Definitions + +resource rMenu (colorMenu) { + 1, // menuID + $A000, // menuFlag + ballColorStr, { // menuTitleRef + redMenuItem, + blueMenuItem, + greenMenuItem, + purpleMenuItem, + yellowMenuItem, + turquoiseMenuItem + }; +}; + +// --- Menu Item Definitions + +resource rMenuItem (blueMenuItem, $C018) { + $0001, // itemID + "","", // itemChar, itemAltChar + NIL, // itemCheck + $8000, // itemFlag + BlueStr // itemTitleRef +}; + +resource rMenuItem (greenMenuItem, $C018) { + $0010, // itemID + "","", // itemChar, itemAltChar + NIL, // itemCheck + $8000, // itemFlag + GreenStr // itemTitleRef +}; + +resource rMenuItem (purpleMenuItem, $C018) { + $0101, // itemID + "","", // itemChar, itemAltChar + NIL, // itemCheck + $8000, // itemFlag + PurpleStr // itemTitleRef +}; + +resource rMenuItem (yellowMenuItem, $C018) { + $0110, // itemID + "","", // itemChar, itemAltChar + NIL, // itemCheck + $8000, // itemFlag + YellowStr // itemTitleRef +}; + +resource rMenuItem (turquoiseMenuItem, $C018) { + $0011, // itemID + "","", // itemChar, itemAltChar + NIL, // itemCheck + $8000, // itemFlag + TurquoiseStr // itemTitleRef +}; + +resource rMenuItem (redMenuItem) { + $0100, // itemID + "","", // itemChar, itemAltChar + NIL, // itemCheck + $8000, // itemFlag + RedStr // itemTitleRef +}; + +// --- rTextForLETextBox2 Templates + +resource rTextForLETextBox2 (1) { + " Ball Options " +}; + +// finally, the ball sound - read in a binary image of the rSound + +read rSoundSample (0x1,locked,nocrossbank,nospecialmemory) "rSound.bin";