05-18-2022, 09:25 PM
I hope this works on other computers.
This works on my HP windows11 laptop.
This works on my HP windows11 laptop.
Code: (Select All)
$NoPrefix
screen1& = NewImage(1360, 748, 256)
Screen screen1&
ScreenMove -2, -2
Dim Shared mx, my, row, column, zone, c1, c2, c3, c4, btn, pieceup, c1a, c2a, c3a, c4a, mz As Integer
Dim Shared gameover, lastzone, mousereleased, playagain, test, tcode1, tcode2, tcode3 As Integer
Dim Shared triquad(80, 4) As Integer
Dim Shared startquad(80, 4) As Integer
Dim Shared quadx(80) As Integer
Dim Shared quady(80) As Integer
playagain = 1: mz = 0: test = 0
Randomize Timer
setupcolors
Color 10, 11
Cls
While playagain = 1
menu
If mz = 1 Then game1setup
If mz = 2 Then game2setup
If mz = 3 Then game3setup
If mz = 4 Then game4setup
If mz = 5 Then game5setup
If mz = 6 Then game6setup
If mz = 7 Then game7setup
If mz = 8 Then game8setup
If mz = 9 Then game9setup
Color 10, 11
gameover = 0: lastzone = 0: pieceup = 0: mousereleased = 0:
snd 1: snd 2: snd 1
If mz < 5 Then mainloop
If mz = 5 Then mainloop2
If mz = 6 Then mainloop2
If mz = 7 Then mainloop3
If mz = 8 Then mainloop3
If mz = 9 Then mainloop3
EndScreen
Color 10, 11
Cls
Wend
End
Sub game1setup
setupdata
shuffle
makeboard
End Sub
Sub game2setup
setupdata
shuffle
makeboard
End Sub
Sub game3setup
setupdata
shuffle
makeboard
End Sub
Sub game4setup
setupdata
shuffle
makeboard
End Sub
Sub game5setup
setupdata2
shuffle2
makeboard2
End Sub
Sub game6setup
setupdata2
shuffle2
makeboard2
End Sub
Sub game7setup
setupdata3
shuffle3
makeboard3
End Sub
Sub game8setup
setupdata3
shuffle3
makeboard3
End Sub
Sub game9setup
setupdata3
shuffle3
makeboard3
End Sub
Sub menu
Color 10
mz = 0
a = 0: k$ = ""
Locate 10, 60: Print "THE GAME OF TRIQUAD"
Locate 12, 40: Print " To solve this puzzle, move all of the squares"
Locate 13, 40: Print " from the left side of the screen to the right side "
Locate 14, 40: Print " of the screen, using the mouse."
Locate 16, 40: Print " All triangles that touch, must be of the same color"
Locate 17, 40: Print " to win ."
Locate 20, 60: Print " SELECT GAME BUTTON WITH MOUSE TO START "
Locate 22, 60: Print " http://rb23.yolasite.com/ "
x = 198
For cnt = 1 To 9
y = 395 ' make 9 menu keys
box x, y, 60, 13
box2 x, y, 60, 10
box x + 10, y + 10, 40, 3
box2 x + 10, y + 10, 40, 10
x = x + 80
Locate 27, 18 + 10 * cnt: Print cnt
Next
Do
k$ = InKey$
If k$ <> "" Then a = 1
If MouseInput Then
mx = MouseX
my = MouseY
btn = MouseButton(1)
If btn = -1 And my > 400 And my < 460 Then ' select menu button (mz)
If mx > 200 And mx < 260 Then mz = 1
If mx > 280 And mx < 340 Then mz = 2
If mx > 360 And mx < 420 Then mz = 3
If mx > 440 And mx < 500 Then mz = 4
If mx > 520 And mx < 580 Then mz = 5
If mx > 600 And mx < 660 Then mz = 6
If mx > 680 And mx < 790 Then mz = 7
If mx > 760 And mx < 820 Then mz = 8
If mx > 840 And mx < 900 Then mz = 9
If mx > 900 Then test = 1
If mx > 900 Then Print " * "
End If
If mz = 1 Then a = 1
If mz = 2 Then a = 1
If mz = 3 Then a = 1
If mz = 4 Then a = 1
If mz = 5 Then a = 1
If mz = 6 Then a = 1
If mz = 7 Then a = 1
If mz = 8 Then a = 1
If mz = 9 Then a = 1
End If
Loop Until a = 1
Color 10, 11
Cls
End Sub
Sub EndScreen
a = 0: k$ = ""
Color 1, 11
Cls
Locate 10, 40
Print " PRESS ESCAPE KEY TO EXIT"
Locate 20, 40
Print " HIT SPACE BAR TO PLAY AGAIN "
Do
k$ = InKey$
If k$ = " " Then a = 1
If k$ = Chr$(27) Then playagain = 0: a = 1
Loop Until a = 1
End Sub
Sub shuffle
Dim t1, t2, t3, t4, q1, q2, q3, q4, r1, r2 As Integer ' temporary variables
If mz < 3 Then
t1 = triquad(3, 1) ' store colors in temporary variables
t2 = triquad(3, 2)
t3 = triquad(3, 3)
t4 = triquad(3, 4)
triquad(3, 1) = 0 ' clear color array
triquad(3, 2) = 0
triquad(3, 3) = 0
triquad(3, 4) = 0
triquad(12, 1) = t1 ' store variables to color array
triquad(12, 2) = t2
triquad(12, 3) = t3
triquad(12, 4) = t4
End If
If mz = 1 Then
q1 = triquad(9, 1) ' store colors in temporary variables
q2 = triquad(9, 2)
q3 = triquad(9, 3)
q4 = triquad(9, 4)
triquad(9, 1) = 0 ' clear color array
triquad(9, 2) = 0
triquad(9, 3) = 0
triquad(9, 4) = 0
triquad(18, 1) = q1 ' store variables to color array
triquad(18, 2) = q2
triquad(18, 3) = q3
triquad(18, 4) = q4
End If
t1 = 0: t2 = 0: t3 = 0: t4 = 0: q1 = 0: q2 = 0: q3 = 0: q4 = 0
' save solution data
For q = 1 To 9
startquad(q, 1) = triquad(q, 1)
startquad(q, 2) = triquad(q, 2)
startquad(q, 3) = triquad(q, 3)
startquad(q, 4) = triquad(q, 4)
Next
makeboard: Sleep 4
For cnt = 1 To 8 ' number of times to shuffle
If test = 0 Then
r1 = Int(Rnd * 9) + 1 ' from 8 or 9???
r2 = Int(Rnd * 9) + 1 ' to
End If
' This test mode makes square 9 the correct move for square 18
If test = 1 Then
r1 = Int(Rnd * 8) + 1 ' from 8 or 9???
r2 = Int(Rnd * 8) + 1 ' to
End If
t1 = triquad(r1, 1) ' store colors in temporary variables
t2 = triquad(r1, 2)
t3 = triquad(r1, 3)
t4 = triquad(r1, 4)
q1 = triquad(r2, 1)
q2 = triquad(r2, 2)
q3 = triquad(r2, 3)
q4 = triquad(r2, 4)
triquad(r2, 1) = t1 ' swap variables and store to color arrays
triquad(r2, 2) = t2
triquad(r2, 3) = t3
triquad(r2, 4) = t4
triquad(r1, 1) = q1
triquad(r1, 2) = q2
triquad(r1, 3) = q3
triquad(r1, 4) = q4
Next
End Sub
Sub shuffle3
Dim t1, t2, t3, t4, q1, q2, q3, q4, r1, r2 As Integer ' temporary variables
t1 = 0: t2 = 0: t3 = 0: t4 = 0: q1 = 0: q2 = 0: q3 = 0: q4 = 0
If mz = 7 Then
t1 = triquad(5, 1) ' store colors in temporary variables
t2 = triquad(5, 2)
t3 = triquad(5, 3)
t4 = triquad(5, 4)
triquad(5, 1) = 0 ' clear color array
triquad(5, 2) = 0
triquad(5, 3) = 0
triquad(5, 4) = 0
triquad(30, 1) = t1 ' store variables to color array
triquad(30, 2) = t2
triquad(30, 3) = t3
triquad(30, 4) = t4
t1 = triquad(25, 1) ' store colors in temporary variables
t2 = triquad(25, 2)
t3 = triquad(25, 3)
t4 = triquad(25, 4)
triquad(25, 1) = 0 ' clear color array
triquad(25, 2) = 0
triquad(25, 3) = 0
triquad(25, 4) = 0
triquad(50, 1) = t1 ' store variables to color array
triquad(50, 2) = t2
triquad(50, 3) = t3
triquad(50, 4) = t4
t1 = triquad(1, 1) ' store colors in temporary variables
t2 = triquad(1, 2)
t3 = triquad(1, 3)
t4 = triquad(1, 4)
triquad(1, 1) = 0 ' clear color array
triquad(1, 2) = 0
triquad(1, 3) = 0
triquad(1, 4) = 0
triquad(26, 1) = t1 ' store variables to color array
triquad(26, 2) = t2
triquad(26, 3) = t3
triquad(26, 4) = t4
t1 = triquad(21, 1) ' store colors in temporary variables
t2 = triquad(21, 2)
t3 = triquad(21, 3)
t4 = triquad(21, 4)
triquad(21, 1) = 0 ' clear color array
triquad(21, 2) = 0
triquad(21, 3) = 0
triquad(21, 4) = 0
triquad(46, 1) = t1 ' store variables to color array
triquad(46, 2) = t2
triquad(46, 3) = t3
triquad(46, 4) = t4
End If
If mz = 8 Then
t1 = triquad(5, 1) ' store colors in temporary variables
t2 = triquad(5, 2)
t3 = triquad(5, 3)
t4 = triquad(5, 4)
triquad(5, 1) = 0 ' clear color array
triquad(5, 2) = 0
triquad(5, 3) = 0
triquad(5, 4) = 0
triquad(30, 1) = t1 ' store variables to color array
triquad(30, 2) = t2
triquad(30, 3) = t3
triquad(30, 4) = t4
t1 = triquad(25, 1) ' store colors in temporary variables
t2 = triquad(25, 2)
t3 = triquad(25, 3)
t4 = triquad(25, 4)
triquad(25, 1) = 0 ' clear color array
triquad(25, 2) = 0
triquad(25, 3) = 0
triquad(25, 4) = 0
triquad(50, 1) = t1 ' store variables to color array
triquad(50, 2) = t2
triquad(50, 3) = t3
triquad(50, 4) = t4
End If
' save solution data
For q = 1 To 25
startquad(q, 1) = triquad(q, 1)
startquad(q, 2) = triquad(q, 2)
startquad(q, 3) = triquad(q, 3)
startquad(q, 4) = triquad(q, 4)
Next
makeboard3: Sleep 4
t1 = 0: t2 = 0: t3 = 0: t4 = 0: q1 = 0: q2 = 0: q3 = 0: q4 = 0
For z = 1 To 11 ' number of times to shuffle
If test = 0 Then
r1 = Int(Rnd * 25) + 1 ' from
r2 = Int(Rnd * 25) + 1 ' to
End If
' This test mode makes square 23,24,25 the correct move for square 48,49,50
If test = 1 Then
r1 = Int(Rnd * 22) + 1 ' from
r2 = Int(Rnd * 22) + 1 ' to
End If
t1 = triquad(r1, 1) ' store colors in temporary variables
t2 = triquad(r1, 2)
t3 = triquad(r1, 3)
t4 = triquad(r1, 4)
q1 = triquad(r2, 1)
q2 = triquad(r2, 2)
q3 = triquad(r2, 3)
q4 = triquad(r2, 4)
triquad(r2, 1) = t1 ' swap variables and store to color arrays
triquad(r2, 2) = t2
triquad(r2, 3) = t3
triquad(r2, 4) = t4
triquad(r1, 1) = q1
triquad(r1, 2) = q2
triquad(r1, 3) = q3
triquad(r1, 4) = q4
Next
End Sub
Sub shuffle2
Dim t1, t2, t3, t4, q1, q2, q3, q4, r1, r2 As Integer
t1 = 0: t2 = 0: t3 = 0: t4 = 0: q1 = 0: q2 = 0: q3 = 0: q4 = 0: r1 = 0: r2 = 0
If mz = 5 Then
t1 = triquad(4, 1) ' store colors in temporary variables
t2 = triquad(4, 2)
t3 = triquad(4, 3)
t4 = triquad(4, 4)
triquad(4, 1) = 0 ' clear color array
triquad(4, 2) = 0
triquad(4, 3) = 0
triquad(4, 4) = 0
triquad(20, 1) = t1 ' store variables to color array
triquad(20, 2) = t2
triquad(20, 3) = t3
triquad(20, 4) = t4
t1 = triquad(16, 1) ' store colors in temporary variables
t2 = triquad(16, 2)
t3 = triquad(16, 3)
t4 = triquad(16, 4)
triquad(16, 1) = 0 ' clear color array
triquad(16, 2) = 0
triquad(16, 3) = 0
triquad(16, 4) = 0
triquad(32, 1) = t1 ' store variables to color array
triquad(32, 2) = t2
triquad(32, 3) = t3
triquad(32, 4) = t4
t1 = triquad(13, 1) ' store colors in temporary variables
t2 = triquad(13, 2)
t3 = triquad(13, 3)
t4 = triquad(13, 4)
triquad(13, 1) = 0 ' clear color array
triquad(13, 2) = 0
triquad(13, 3) = 0
triquad(13, 4) = 0
triquad(29, 1) = t1 ' store variables to color array
triquad(29, 2) = t2
triquad(29, 3) = t3
triquad(29, 4) = t4
End If
' save solution data
For q = 1 To 16
startquad(q, 1) = triquad(q, 1)
startquad(q, 2) = triquad(q, 2)
startquad(q, 3) = triquad(q, 3)
startquad(q, 4) = triquad(q, 4)
Next
makeboard2: Sleep 4
For z = 1 To 11 ' number of times to shuffle
t1 = 0: t2 = 0: t3 = 0: t4 = 0: q1 = 0: q2 = 0: q3 = 0: q4 = 0: r1 = 0: r2 = 0
If test = 0 Then
r1 = Int(Rnd * 16) + 1 ' from
r2 = Int(Rnd * 16) + 1 ' to
End If
' This test mode makes square 14,15,16 the correct move for square 30,31,32 used for testing
If test = 1 Then
r1 = Int(Rnd * 13) + 1 ' from
r2 = Int(Rnd * 13) + 1 ' to
End If
t1 = triquad(r1, 1) ' store colors in temporary variables
t2 = triquad(r1, 2)
t3 = triquad(r1, 3)
t4 = triquad(r1, 4)
q1 = triquad(r2, 1)
q2 = triquad(r2, 2)
q3 = triquad(r2, 3)
q4 = triquad(r2, 4)
triquad(r2, 1) = t1 ' swap variables and store to color arrays
triquad(r2, 2) = t2
triquad(r2, 3) = t3
triquad(r2, 4) = t4
triquad(r1, 1) = q1
triquad(r1, 2) = q2
triquad(r1, 3) = q3
triquad(r1, 4) = q4
Next
End Sub
Sub checkboard
' check to see if game over
Dim p1, p2, p3, p4, c As Integer
c = 0
For cnt = 10 To 18
For cnt2 = 1 To 4
p1 = triquad(cnt, 1): p2 = triquad(cnt, 2): p3 = triquad(cnt, 3): p4 = triquad(cnt, 4)
If cnt = 10 And p2 > 0 And triquad(11, 4) = p2 Then c = c + 1
If cnt = 10 And p3 > 0 And triquad(13, 1) = p3 Then c = c + 1
If cnt = 11 And p2 > 0 And triquad(12, 4) = p2 Then c = c + 1
If cnt = 11 And p3 > 0 And triquad(14, 1) = p3 Then c = c + 1
If cnt = 12 And p3 > 0 And triquad(15, 1) = p3 Then c = c + 1
If cnt = 13 And p2 > 0 And triquad(14, 4) = p2 Then c = c + 1
If cnt = 13 And p3 > 0 And triquad(16, 1) = p3 Then c = c + 1
If cnt = 14 And p2 > 0 And triquad(15, 4) = p2 Then c = c + 1
If cnt = 14 And p3 > 0 And triquad(17, 1) = p3 Then c = c + 1
If cnt = 15 And p3 > 0 And triquad(18, 1) = p3 Then c = c + 1
If cnt = 16 And p2 > 0 And triquad(17, 4) = p2 Then c = c + 1
If cnt = 17 And p2 > 0 And triquad(18, 4) = p2 Then c = c + 1
Next
Next
If c = 48 Then Locate 2, 30: Print " PUZZLE SOLVED "
End Sub
Sub checkboard3
' check to see if game over
Dim p1, p2, p3, p4, c As Integer
c = 0
For cnt = 26 To 50
For cnt2 = 1 To 4
p1 = triquad(cnt, 1): p2 = triquad(cnt, 2): p3 = triquad(cnt, 3): p4 = triquad(cnt, 4)
If cnt = 26 And p2 > 0 And triquad(27, 4) = p2 Then c = c + 1
If cnt = 26 And p3 > 0 And triquad(31, 1) = p3 Then c = c + 1
If cnt = 27 And p2 > 0 And triquad(28, 4) = p2 Then c = c + 1
If cnt = 27 And p3 > 0 And triquad(32, 1) = p3 Then c = c + 1
If cnt = 28 And p2 > 0 And triquad(29, 4) = p2 Then c = c + 1
If cnt = 28 And p3 > 0 And triquad(33, 1) = p3 Then c = c + 1
If cnt = 29 And p2 > 0 And triquad(30, 4) = p2 Then c = c + 1
If cnt = 29 And p3 > 0 And triquad(34, 1) = p3 Then c = c + 1
If cnt = 30 And p3 > 0 And triquad(35, 1) = p3 Then c = c + 1
If cnt = 31 And p2 > 0 And triquad(32, 4) = p2 Then c = c + 1
If cnt = 31 And p3 > 0 And triquad(36, 1) = p3 Then c = c + 1
If cnt = 32 And p2 > 0 And triquad(33, 4) = p2 Then c = c + 1
If cnt = 32 And p3 > 0 And triquad(37, 1) = p3 Then c = c + 1
If cnt = 33 And p2 > 0 And triquad(34, 4) = p2 Then c = c + 1
If cnt = 33 And p3 > 0 And triquad(38, 1) = p3 Then c = c + 1
If cnt = 34 And p2 > 0 And triquad(35, 4) = p2 Then c = c + 1
If cnt = 34 And p3 > 0 And triquad(39, 1) = p3 Then c = c + 1
If cnt = 35 And p3 > 0 And triquad(40, 1) = p3 Then c = c + 1
If cnt = 36 And p2 > 0 And triquad(37, 4) = p2 Then c = c + 1
If cnt = 36 And p3 > 0 And triquad(41, 1) = p3 Then c = c + 1
If cnt = 37 And p2 > 0 And triquad(38, 4) = p2 Then c = c + 1
If cnt = 37 And p3 > 0 And triquad(42, 1) = p3 Then c = c + 1
If cnt = 38 And p2 > 0 And triquad(39, 4) = p2 Then c = c + 1
If cnt = 38 And p3 > 0 And triquad(43, 1) = p3 Then c = c + 1
If cnt = 39 And p3 > 0 And triquad(40, 4) = p2 Then c = c + 1
If cnt = 39 And p3 > 0 And triquad(44, 1) = p3 Then c = c + 1
If cnt = 40 And p3 > 0 And triquad(45, 1) = p3 Then c = c + 1
If cnt = 41 And p2 > 0 And triquad(42, 4) = p2 Then c = c + 1
If cnt = 41 And p3 > 0 And triquad(46, 1) = p3 Then c = c + 1
If cnt = 42 And p2 > 0 And triquad(43, 4) = p2 Then c = c + 1
If cnt = 42 And p3 > 0 And triquad(47, 1) = p3 Then c = c + 1
If cnt = 43 And p2 > 0 And triquad(44, 4) = p2 Then c = c + 1
If cnt = 43 And p3 > 0 And triquad(48, 1) = p3 Then c = c + 1
If cnt = 44 And p2 > 0 And triquad(45, 4) = p2 Then c = c + 1
If cnt = 44 And p3 > 0 And triquad(49, 1) = p3 Then c = c + 1
If cnt = 45 And p3 > 0 And triquad(50, 1) = p3 Then c = c + 1
If cnt = 46 And p2 > 0 And triquad(47, 4) = p2 Then c = c + 1
If cnt = 47 And p2 > 0 And triquad(48, 4) = p2 Then c = c + 1
If cnt = 48 And p2 > 0 And triquad(49, 4) = p2 Then c = c + 1
If cnt = 49 And p2 > 0 And triquad(50, 4) = p2 Then c = c + 1
Next
Next
If c = 160 Then Locate 2, 30: Print " PUZZLE SOLVED "
End Sub
Sub checkboard2
' check to see if game over
Dim p1, p2, p3, p4, c As Integer
c = 0
For cnt = 17 To 32
For cnt2 = 1 To 4
p1 = triquad(cnt, 1): p2 = triquad(cnt, 2): p3 = triquad(cnt, 3): p4 = triquad(cnt, 4)
If cnt = 17 And p2 > 0 And triquad(18, 4) = p2 Then c = c + 1
If cnt = 17 And p3 > 0 And triquad(21, 1) = p3 Then c = c + 1
If cnt = 18 And p2 > 0 And triquad(19, 4) = p2 Then c = c + 1
If cnt = 18 And p3 > 0 And triquad(22, 1) = p3 Then c = c + 1
If cnt = 19 And p2 > 0 And triquad(20, 4) = p2 Then c = c + 1
If cnt = 19 And p3 > 0 And triquad(23, 1) = p3 Then c = c + 1
If cnt = 20 And p3 > 0 And triquad(24, 1) = p3 Then c = c + 1
If cnt = 21 And p2 > 0 And triquad(22, 4) = p2 Then c = c + 1
If cnt = 21 And p3 > 0 And triquad(25, 1) = p3 Then c = c + 1
If cnt = 22 And p2 > 0 And triquad(23, 4) = p2 Then c = c + 1
If cnt = 22 And p3 > 0 And triquad(26, 1) = p3 Then c = c + 1
If cnt = 23 And p2 > 0 And triquad(24, 4) = p2 Then c = c + 1
If cnt = 23 And p3 > 0 And triquad(27, 1) = p3 Then c = c + 1
If cnt = 24 And p3 > 0 And triquad(28, 1) = p3 Then c = c + 1
If cnt = 25 And p2 > 0 And triquad(26, 4) = p2 Then c = c + 1
If cnt = 25 And p3 > 0 And triquad(29, 1) = p3 Then c = c + 1
If cnt = 26 And p2 > 0 And triquad(27, 4) = p2 Then c = c + 1
If cnt = 26 And p3 > 0 And triquad(30, 1) = p3 Then c = c + 1
If cnt = 27 And p2 > 0 And triquad(28, 4) = p2 Then c = c + 1
If cnt = 27 And p3 > 0 And triquad(31, 1) = p3 Then c = c + 1
If cnt = 28 And p3 > 0 And triquad(32, 1) = p3 Then c = c + 1
If cnt = 29 And p2 > 0 And triquad(30, 4) = p2 Then c = c + 1
If cnt = 30 And p2 > 0 And triquad(31, 4) = p2 Then c = c + 1
If cnt = 31 And p2 > 0 And triquad(32, 4) = p2 Then c = c + 1
Next
Next
If c = 96 Then Locate 2, 40: Print " PUZZLE SOLVED "
End Sub
Sub setupdata
Dim z, r1, r2, r3, r4 As Integer
tcode1 = 0
quadx(1) = 50: quadx(2) = 250: quadx(3) = 450: quadx(4) = 50: quadx(5) = 250: quadx(6) = 450: quadx(7) = 50: quadx(8) = 250: quadx(9) = 450
quady(1) = 100: quady(2) = 100: quady(3) = 100: quady(4) = 300: quady(5) = 300: quady(6) = 300: quady(7) = 500: quady(8) = 500: quady(9) = 500
quadx(10) = 700: quadx(11) = 900: quadx(12) = 1100: quadx(13) = 700: quadx(14) = 900: quadx(15) = 1100: quadx(16) = 700: quadx(17) = 900: quadx(18) = 1100
quady(10) = 100: quady(11) = 100: quady(12) = 100: quady(13) = 300: quady(14) = 300: quady(15) = 300: quady(16) = 500: quady(17) = 500: quady(18) = 500
' setup random colors
For z = 1 To 9
If z = 1 Or z = 3 Or z = 5 Or z = 7 Or z = 9 Then
r1 = Int(Rnd * 9) + 1: triquad(z, 1) = r1
r2 = Int(Rnd * 9) + 1: triquad(z, 2) = r2
r3 = Int(Rnd * 9) + 1: triquad(z, 3) = r3
r4 = Int(Rnd * 9) + 1: triquad(z, 4) = r4
End If
Next
If mz = 4 Then
For z = 1 To 9
If z = 1 Or z = 3 Or z = 5 Or z = 7 Or z = 9 Then
r1 = Int(Rnd * 30) + 1
triquad(z, 1) = r1
r2 = Int(Rnd * 30) + 1
triquad(z, 2) = r2
r3 = Int(Rnd * 30) + 1
triquad(z, 3) = r3
r4 = Int(Rnd * 30) + 1
triquad(z, 4) = r4
End If
Next
End If
For z = 10 To 18
triquad(z, 1) = 0
triquad(z, 2) = 0
triquad(z, 3) = 0
triquad(z, 4) = 0
Next
triquad(2, 1) = r1: triquad(2, 2) = triquad(3, 4): triquad(2, 3) = triquad(5, 1): triquad(2, 4) = triquad(1, 2)
triquad(4, 1) = triquad(1, 3): triquad(4, 2) = triquad(5, 4): triquad(4, 3) = triquad(7, 1): triquad(4, 4) = r2
triquad(6, 1) = triquad(3, 3): triquad(6, 2) = r4: triquad(6, 3) = triquad(9, 1): triquad(6, 4) = triquad(5, 2)
triquad(8, 1) = triquad(5, 3): triquad(8, 2) = triquad(9, 4): triquad(8, 3) = r4: triquad(8, 4) = triquad(7, 2)
For z = 1 To 9
r1 = triquad(z, 1)
r2 = triquad(z, 2)
r3 = triquad(z, 3)
r4 = triquad(z, 4)
tcode1 = tcode1 + r1 + r2 * 10 + r3 * 100 + r4 * 1000
Next
End Sub
Sub setupdata3
Dim z, r1, r2, r3, r4 As Integer
' set up locations
quadx(1) = 50: quadx(2) = 150: quadx(3) = 250: quadx(4) = 350: quadx(5) = 450
quadx(6) = 50: quadx(7) = 150: quadx(8) = 250: quadx(9) = 350: quadx(10) = 450
quadx(11) = 50: quadx(12) = 150: quadx(13) = 250: quadx(14) = 350: quadx(15) = 450
quadx(16) = 50: quadx(17) = 150: quadx(18) = 250: quadx(19) = 350: quadx(20) = 450
quadx(21) = 50: quadx(22) = 150: quadx(23) = 250: quadx(24) = 350: quadx(25) = 450
quady(1) = 100: quady(2) = 100: quady(3) = 100: quady(4) = 100: quady(5) = 100
quady(6) = 200: quady(7) = 200: quady(8) = 200: quady(9) = 200: quady(10) = 200
quady(11) = 300: quady(12) = 300: quady(13) = 300: quady(14) = 300: quady(15) = 300
quady(16) = 400: quady(17) = 400: quady(18) = 400: quady(19) = 400: quady(20) = 400
quady(21) = 500: quady(22) = 500: quady(23) = 500: quady(24) = 500: quady(25) = 500
quadx(26) = 650: quadx(27) = 750: quadx(28) = 850: quadx(29) = 950: quadx(30) = 1050
quadx(31) = 650: quadx(32) = 750: quadx(33) = 850: quadx(34) = 950: quadx(35) = 1050
quadx(36) = 650: quadx(37) = 750: quadx(38) = 850: quadx(39) = 950: quadx(40) = 1050
quadx(41) = 650: quadx(42) = 750: quadx(43) = 850: quadx(44) = 950: quadx(45) = 1050
quadx(46) = 650: quadx(47) = 750: quadx(48) = 850: quadx(49) = 950: quadx(50) = 1050
quady(26) = 100: quady(27) = 100: quady(28) = 100: quady(29) = 100: quady(30) = 100
quady(31) = 200: quady(32) = 200: quady(33) = 200: quady(34) = 200: quady(35) = 200
quady(36) = 300: quady(37) = 300: quady(38) = 300: quady(39) = 300: quady(40) = 300
quady(41) = 400: quady(42) = 400: quady(43) = 400: quady(44) = 400: quady(45) = 400
quady(46) = 500: quady(47) = 500: quady(48) = 500: quady(49) = 500: quady(50) = 500
' setup random colors
For z = 1 To 25
r1 = Int(Rnd * 44) + 1
triquad(z, 1) = r1
r2 = Int(Rnd * 44) + 1
triquad(z, 2) = r2
r3 = Int(Rnd * 44) + 1
triquad(z, 3) = r3
r4 = Int(Rnd * 44) + 1
triquad(z, 4) = r4
Next
For z = 26 To 50
triquad(z, 1) = 0
triquad(z, 2) = 0
triquad(z, 3) = 0
triquad(z, 4) = 0
Next
triquad(1, 2) = triquad(2, 4): triquad(2, 2) = triquad(3, 4): triquad(3, 2) = triquad(4, 4): triquad(4, 2) = triquad(5, 4)
triquad(6, 2) = triquad(7, 4): triquad(7, 2) = triquad(8, 4): triquad(8, 2) = triquad(9, 4): triquad(9, 2) = triquad(10, 4)
triquad(11, 2) = triquad(12, 4): triquad(12, 2) = triquad(13, 4): triquad(13, 2) = triquad(14, 4): triquad(14, 2) = triquad(15, 4)
triquad(16, 2) = triquad(17, 4): triquad(17, 2) = triquad(18, 4): triquad(18, 2) = triquad(19, 4): triquad(19, 2) = triquad(20, 4)
triquad(21, 2) = triquad(22, 4): triquad(22, 2) = triquad(23, 4): triquad(23, 2) = triquad(24, 4): triquad(24, 2) = triquad(25, 4)
triquad(1, 3) = triquad(6, 1): triquad(2, 3) = triquad(7, 1): triquad(3, 3) = triquad(8, 1): triquad(4, 3) = triquad(9, 1): triquad(5, 3) = triquad(10, 1)
triquad(6, 3) = triquad(11, 1): triquad(7, 3) = triquad(12, 1): triquad(8, 3) = triquad(13, 1): triquad(9, 3) = triquad(14, 1): triquad(10, 3) = triquad(15, 1)
triquad(11, 3) = triquad(16, 1): triquad(12, 3) = triquad(17, 1): triquad(13, 3) = triquad(18, 1): triquad(14, 3) = triquad(19, 1): triquad(15, 3) = triquad(20, 1)
triquad(16, 3) = triquad(21, 1): triquad(17, 3) = triquad(22, 1): triquad(18, 3) = triquad(23, 1): triquad(19, 3) = triquad(24, 1): triquad(20, 3) = triquad(25, 1)
' makeboard3: Sleep 300
End Sub
Sub setupdata2
' set up locations
Dim z, r1, r2, r3, r4 As Integer
quadx(1) = 50: quadx(2) = 150: quadx(3) = 250: quadx(4) = 350
quadx(5) = 50: quadx(6) = 150: quadx(7) = 250: quadx(8) = 350
quadx(9) = 50: quadx(10) = 150: quadx(11) = 250: quadx(12) = 350
quadx(13) = 50: quadx(14) = 150: quadx(15) = 250: quadx(16) = 350
quady(1) = 200: quady(2) = 200: quady(3) = 200: quady(4) = 200
quady(5) = 300: quady(6) = 300: quady(7) = 300: quady(8) = 300
quady(9) = 400: quady(10) = 400: quady(11) = 400: quady(12) = 400
quady(13) = 500: quady(14) = 500: quady(15) = 500: quady(16) = 500
quadx(17) = 550: quadx(18) = 650: quadx(19) = 750: quadx(20) = 850
quadx(21) = 550: quadx(22) = 650: quadx(23) = 750: quadx(24) = 850
quadx(25) = 550: quadx(26) = 650: quadx(27) = 750: quadx(28) = 850
quadx(29) = 550: quadx(30) = 650: quadx(31) = 750: quadx(32) = 850
quady(17) = 200: quady(18) = 200: quady(19) = 200: quady(20) = 200
quady(21) = 300: quady(22) = 300: quady(23) = 300: quady(24) = 300
quady(25) = 400: quady(26) = 400: quady(27) = 400: quady(28) = 400
quady(29) = 500: quady(30) = 500: quady(31) = 500: quady(32) = 500
' setup random colors
For z = 1 To 16
r1 = Int(Rnd * 23) + 1
triquad(z, 1) = r1
r2 = Int(Rnd * 23) + 1
triquad(z, 2) = r2
r3 = Int(Rnd * 23) + 1
triquad(z, 3) = r3
r4 = Int(Rnd * 23) + 1
triquad(z, 4) = r4
Next
For z = 17 To 32
triquad(z, 1) = 0
triquad(z, 2) = 0
triquad(z, 3) = 0
triquad(z, 4) = 0
Next
triquad(1, 2) = triquad(2, 4): triquad(2, 2) = triquad(3, 4): triquad(3, 2) = triquad(4, 4)
triquad(5, 2) = triquad(6, 4): triquad(6, 2) = triquad(7, 4): triquad(7, 2) = triquad(8, 4)
triquad(9, 2) = triquad(10, 4): triquad(10, 2) = triquad(11, 4): triquad(11, 2) = triquad(12, 4)
triquad(13, 2) = triquad(14, 4): triquad(14, 2) = triquad(15, 4): triquad(15, 2) = triquad(16, 4)
triquad(1, 3) = triquad(5, 1): triquad(5, 3) = triquad(9, 1): triquad(9, 3) = triquad(13, 1)
triquad(2, 3) = triquad(6, 1): triquad(6, 3) = triquad(10, 1): triquad(10, 3) = triquad(14, 1)
triquad(3, 3) = triquad(7, 1): triquad(7, 3) = triquad(11, 1): triquad(11, 3) = triquad(15, 1)
triquad(4, 3) = triquad(8, 1): triquad(8, 3) = triquad(12, 1): triquad(12, 3) = triquad(16, 1)
' printglobals
End Sub
Sub mainloop3
Dim a As Integer
pieceup = 0: btn = 0: row = 0: column = 0: zone = 0
makeboard3
Do
row = 0: column = 0: zone = 0
key$ = InKey$
If key$ <> "" Then Print key$; " "
Do While MouseInput
mx = MouseX
my = MouseY
If my > 100 And my < 190 Then row = 1
If my > 200 And my < 290 Then row = 2
If my > 300 And my < 390 Then row = 3
If my > 400 And my < 490 Then row = 4
If my > 500 And my < 590 Then row = 5
If mx > 50 And mx < 140 Then column = 1
If mx > 150 And mx < 240 Then column = 2
If mx > 250 And mx < 340 Then column = 3
If mx > 350 And mx < 440 Then column = 4
If mx > 450 And mx < 540 Then column = 5
If mx > 650 And mx < 740 Then column = 6
If mx > 750 And mx < 840 Then column = 7
If mx > 850 And mx < 940 Then column = 8
If mx > 950 And mx < 1040 Then column = 9
If mx > 1050 And mx < 1140 Then column = 10
If column = 0 Then row = 0
If row = 0 Then column = 0
getzone3
btn = MouseButton(1)
Loop
If btn = -1 Then
mousereleased = 1
Else
mousereleased = 0
End If
If test = 1 Then printsolution3
If mousereleased = 1 And pieceup = 0 And zone > 0 And triquad(zone, 1) > 0 Then
c1a = triquad(zone, 1): c2a = triquad(zone, 2): c3a = triquad(zone, 3): c4a = triquad(zone, 4)
pickup2
pieceup = 1
zone = 0
Else
If mousereleased = 1 And zone > 0 And pieceup = 1 Then
a = triquad(zone, 1)
If a = 0 Then
putdown3
pieceup = 0
Else
snd 4
c1 = c1a: c2 = c2a: c3 = c3a: c4 = c4a
pieceup = 1
End If
makeboard3
checkboard3
End If
End If
makeboard3
Loop Until key$ = Chr$(27)
End Sub
Sub mainloop2
Dim a As Integer
pieceup = 0: btn = 0: row = 0: column = 0: zone = 0
makeboard2
Do
row = 0: column = 0: zone = 0
key$ = InKey$
If key$ <> "" Then Print key$; " "
Do While MouseInput
mx = MouseX
my = MouseY
If my > 200 And my < 295 Then row = 1
If my > 295 And my < 395 Then row = 2
If my > 395 And my < 495 Then row = 3
If my > 495 And my < 595 Then row = 4
If mx > 50 And mx < 145 Then column = 1
If mx > 145 And mx < 245 Then column = 2
If mx > 245 And mx < 345 Then column = 3
If mx > 345 And mx < 445 Then column = 4
If mx > 545 And mx < 645 Then column = 5
If mx > 645 And mx < 745 Then column = 6
If mx > 745 And mx < 845 Then column = 7
If mx > 845 And mx < 945 Then column = 8
If column = 0 Then row = 0
If row = 0 Then column = 0
getzone2
btn = MouseButton(1)
Loop
If btn = -1 Then
mousereleased = 1
Else
mousereleased = 0
End If
If test = 1 Then printsolution2
If mousereleased = 1 And pieceup = 0 And zone > 0 And triquad(zone, 1) > 0 Then
c1a = triquad(zone, 1): c2a = triquad(zone, 2): c3a = triquad(zone, 3): c4a = triquad(zone, 4)
pickup2
pieceup = 1
' printglobals
zone = 0
Else
If mousereleased = 1 And zone > 0 And pieceup = 1 Then
a = triquad(zone, 1)
If a = 0 Then
putdown2
pieceup = 0
Else
snd 4
c1 = c1a: c2 = c2a: c3 = c3a: c4 = c4a
pieceup = 1
' printglobals
End If
makeboard2
checkboard2
End If
End If
makeboard2
Loop Until key$ = Chr$(27)
End Sub
Sub mainloop
Dim a As Integer
pieceup = 0: btn = 0: row = 0: column = 0: zone = 0
makeboard
Do
row = 0: column = 0: zone = 0
key$ = InKey$
If key$ <> "" Then Print key$; " "
Do While MouseInput
mx = MouseX
my = MouseY
If my > 100 And my < 280 Then row = 1
If my > 300 And my < 480 Then row = 2
If my > 500 And my < 680 Then row = 3
If mx > 50 And mx < 230 Then column = 1
If mx > 250 And mx < 430 Then column = 2
If mx > 450 And mx < 630 Then column = 3
If mx > 700 And mx < 880 Then column = 4
If mx > 900 And mx < 1080 Then column = 5
If mx > 1100 And mx < 1280 Then column = 6
If column = 0 Then row = 0
If row = 0 Then column = 0
getzone
btn = MouseButton(1)
Loop
If btn = -1 Then
mousereleased = 1
Else
mousereleased = 0
End If
If mousereleased = 1 And pieceup = 0 And zone > 0 And triquad(zone, 1) > 0 Then
c1a = triquad(zone, 1): c2a = triquad(zone, 2): c3a = triquad(zone, 3): c4a = triquad(zone, 4)
pickup
pieceup = 1
' printglobals
zone = 0
Else
If mousereleased = 1 And zone > 0 And pieceup = 1 Then
a = triquad(zone, 1)
If a = 0 Then
putdown
pieceup = 0
Else
snd 4
c1 = c1a: c2 = c2a: c3 = c3a: c4 = c4a
pieceup = 1
' printglobals
End If
checkboard
makeboard
End If
End If
makeboard
If test = 1 Then printsolution1
Loop Until key$ = Chr$(27)
End Sub
Sub pickup ()
Dim z, x, y As Integer
z = zone: x = quadx(z): y = quady(z)
c1 = triquad(z, 1): c2 = triquad(z, 2): c3 = triquad(z, 3): c4 = triquad(z, 4)
triquad(z, 1) = 0: triquad(z, 2) = 0: triquad(z, 3) = 0: triquad(z, 4) = 0
snd 1: snd 2
End Sub
Sub putdown ()
Dim z, x, y As Integer
z = zone: x = quadx(z): y = quady(z)
triquad(z, 1) = c1: triquad(z, 2) = c2: triquad(z, 3) = c3: triquad(z, 4) = c4
c1 = 0: c2 = 0: c3 = 0: c4 = 0
snd 2: snd 1: snd 1
End Sub
Sub pickup2 ()
Dim z, x, y As Integer
z = zone: x = quadx(z): y = quady(z)
c1 = triquad(z, 1): c2 = triquad(z, 2): c3 = triquad(z, 3): c4 = triquad(z, 4)
box1$ = " r90 d90 l90 u90 "
bx1$ = " r90 d90 h90 d90 e90 "
box x, y, 90, 0
PSet (x, y), 12
Draw box1$
Draw bx1$
triquad(z, 1) = 0: triquad(z, 2) = 0: triquad(z, 3) = 0: triquad(z, 4) = 0
snd 1: snd 2
End Sub
Sub putdown2 ()
Dim z, x, y As Integer
z = zone: x = quadx(z): y = quady(z)
triquad(z, 1) = c1: triquad(z, 2) = c2: triquad(z, 3) = c3: triquad(z, 4) = c4
makeboard2
c1 = 0: c2 = 0: c3 = 0: c4 = 0
snd 2: snd 1: snd 1
End Sub
Sub putdown3 ()
Dim z, x, y As Integer
z = zone: x = quadx(z): y = quady(z)
triquad(z, 1) = c1: triquad(z, 2) = c2: triquad(z, 3) = c3: triquad(z, 4) = c4
makeboard3
c1 = 0: c2 = 0: c3 = 0: c4 = 0
snd 2: snd 1: snd 1
Locate 5, 20: Print z
End Sub
Sub printsolution1
a = 10
For z = 1 To 9
Locate 2, a: Print startquad(z, 1)
Locate 3, a: Print startquad(z, 2)
Locate 4, a: Print startquad(z, 3)
Locate 5, a: Print startquad(z, 4)
a = a + 4
Next
End Sub
Sub printsolution2
a = 10
For z = 1 To 16
Locate 2, a: Print startquad(z, 1)
Locate 3, a: Print startquad(z, 2)
Locate 4, a: Print startquad(z, 3)
Locate 5, a: Print startquad(z, 4)
a = a + 4
Next
End Sub
Sub printsolution3
a = 10
For z = 1 To 25
Locate 2, a: Print startquad(z, 1)
Locate 3, a: Print startquad(z, 2)
Locate 4, a: Print startquad(z, 3)
Locate 5, a: Print startquad(z, 4)
a = a + 4
Next
End Sub
Sub printglobals ()
Locate 2, 2: Print mx
Locate 3, 2: Print my
Locate 4, 10: Print " Row"
Locate 4, 15: Print row
Locate 4, 20: Print " Column"
Locate 4, 30: Print column
Locate 4, 40: Print " Zone"
Locate 4, 50: Print zone
Locate 4, 60: Print " Btn"
Locate 4, 70: Print btn
Locate 4, 80
If pieceup = 1 Then Print " Pieceup "
If pieceup = 0 Then Print " Piecedown"
Locate 4, 100: Print " Mousereleased "
Locate 4, 120: Print mousereleased
Locate 2, 10: Print c1
Locate 2, 14: Print c2
Locate 2, 18: Print c3
Locate 2, 22: Print c4
Locate 2, 120: Print tcode1
Locate 3, 120: Print tcode2
Locate 4, 120: Print tcode3
' JESUS IS COMMING ... PASS IT ON
End Sub
Sub box (x, y, size, clr)
' x and y are upper left side of box
Line (x, y)-(x + size, y + size), clr, BF , 2 ' Solid box
End Sub
Sub box2 (x, y, size, clr)
' x and y are upper left side of box
Line (x, y)-(x + size, y + size), clr, B ' plain box
End Sub
Sub getzone
Dim z, r, c As Integer
c = column
r = row
z = 0
If r = 1 Then
If c = 1 Then z = 1
If c = 2 Then z = 2
If c = 3 Then z = 3
If c = 4 Then z = 10
If c = 5 Then z = 11
If c = 6 Then z = 12
End If
If r = 2 Then
If c = 1 Then z = 4
If c = 2 Then z = 5
If c = 3 Then z = 6
If c = 4 Then z = 13
If c = 5 Then z = 14
If c = 6 Then z = 15
End If
If r = 3 Then
If c = 1 Then z = 7
If c = 2 Then z = 8
If c = 3 Then z = 9
If c = 4 Then z = 16
If c = 5 Then z = 17
If c = 6 Then z = 18
End If
zone = z
End Sub
Sub getzone3
Dim z, r, c As Integer
c = column
r = row
z = 0
If r = 1 Then
If c = 1 Then z = 1
If c = 2 Then z = 2
If c = 3 Then z = 3
If c = 4 Then z = 4
If c = 5 Then z = 5
If c = 6 Then z = 26
If c = 7 Then z = 27
If c = 8 Then z = 28
If c = 9 Then z = 29
If c = 10 Then z = 30
End If
If r = 2 Then
If c = 1 Then z = 6
If c = 2 Then z = 7
If c = 3 Then z = 8
If c = 4 Then z = 9
If c = 5 Then z = 10
If c = 6 Then z = 31
If c = 7 Then z = 32
If c = 8 Then z = 33
If c = 9 Then z = 34
If c = 10 Then z = 35
End If
If r = 3 Then
If c = 1 Then z = 11
If c = 2 Then z = 12
If c = 3 Then z = 13
If c = 4 Then z = 14
If c = 5 Then z = 15
If c = 6 Then z = 36
If c = 7 Then z = 37
If c = 8 Then z = 38
If c = 9 Then z = 39
If c = 10 Then z = 40
End If
If r = 4 Then
If c = 1 Then z = 16
If c = 2 Then z = 17
If c = 3 Then z = 18
If c = 4 Then z = 19
If c = 5 Then z = 20
If c = 6 Then z = 41
If c = 7 Then z = 42
If c = 8 Then z = 43
If c = 9 Then z = 44
If c = 10 Then z = 45
End If
If r = 5 Then
If c = 1 Then z = 21
If c = 2 Then z = 22
If c = 3 Then z = 23
If c = 4 Then z = 24
If c = 5 Then z = 25
If c = 6 Then z = 46
If c = 7 Then z = 47
If c = 8 Then z = 48
If c = 9 Then z = 49
If c = 10 Then z = 50
End If
zone = z
End Sub
Sub getzone2
Dim z, r, c As Integer
c = column
r = row
z = 0
If r = 1 Then
If c = 1 Then z = 1
If c = 2 Then z = 2
If c = 3 Then z = 3
If c = 4 Then z = 4
If c = 5 Then z = 17
If c = 6 Then z = 18
If c = 7 Then z = 19
If c = 8 Then z = 20
End If
If r = 2 Then
If c = 1 Then z = 5
If c = 2 Then z = 6
If c = 3 Then z = 7
If c = 4 Then z = 8
If c = 5 Then z = 21
If c = 6 Then z = 22
If c = 7 Then z = 23
If c = 8 Then z = 24
End If
If r = 3 Then
If c = 1 Then z = 9
If c = 2 Then z = 10
If c = 3 Then z = 11
If c = 4 Then z = 12
If c = 5 Then z = 25
If c = 6 Then z = 26
If c = 7 Then z = 27
If c = 8 Then z = 28
End If
If r = 4 Then
If c = 1 Then z = 13
If c = 2 Then z = 14
If c = 3 Then z = 15
If c = 4 Then z = 16
If c = 5 Then z = 29
If c = 6 Then z = 30
If c = 7 Then z = 31
If c = 8 Then z = 32
End If
zone = z
End Sub
Sub makeboard3
Dim clr1, clr2, clr3, clr4, sx, sy, z As Integer
z = 1
For q = 1 To 50
sx = quadx(z): sy = quady(z)
clr1 = triquad(z, 1)
clr2 = triquad(z, 2)
clr3 = triquad(z, 3)
clr4 = triquad(z, 4)
box1$ = " r90 d90 l90 u90 "
bx1$ = " r90 d90 h90 d90 e90 "
PSet (sx, sy), 45
Draw box1$
Draw bx1$
Paint (sx + 40, sy + 20), clr1, 45
Paint (sx + 70, sy + 40), clr2, 45
Paint (sx + 40, sy + 60), clr3, 45
Paint (sx + 20, sy + 40), clr4, 45
z = z + 1
Next
End Sub
Sub makeboard2
' box 2, 2, 1360, 11
Dim clr1, clr2, clr3, clr4, sx, sy, z As Integer
For z = 1 To 32
sx = quadx(z): sy = quady(z)
clr1 = triquad(z, 1)
clr2 = triquad(z, 2)
clr3 = triquad(z, 3)
clr4 = triquad(z, 4)
box1$ = " r90 d90 l90 u90 "
bx1$ = " r90 d90 h90 d90 e90 "
PSet (sx, sy), 45
Draw box1$
Draw bx1$
Paint (sx + 40, sy + 20), clr1, 45
Paint (sx + 70, sy + 40), clr2, 45
Paint (sx + 40, sy + 60), clr3, 45
Paint (sx + 20, sy + 40), clr4, 45
Next
End Sub
Sub makeboard
Dim clr1, clr2, clr3, clr4, sx, sy, z As Integer
For z = 1 To 18
sx = quadx(z): sy = quady(z)
clr1 = triquad(z, 1)
clr2 = triquad(z, 2)
clr3 = triquad(z, 3)
clr4 = triquad(z, 4)
box1$ = " r180 d180 l180 u180 "
bx1$ = " r180 d180 h180 d180 e180 "
PSet (sx, sy), 45
Draw box1$
Draw bx1$
Paint (sx + 90, sy + 40), clr1, 45
Paint (sx + 120, sy + 90), clr2, 45
Paint (sx + 90, sy + 120), clr3, 45
Paint (sx + 40, sy + 90), clr4, 45
Next
End Sub
Sub setupcolors ()
PaletteColor 0, RGB32(0, 0, 0) ' black
PaletteColor 1, RGB32(255, 255, 255) ' white
PaletteColor 2, RGB32(0, 255, 0) ' green
PaletteColor 3, RGB32(0, 0, 90) ' dark blue
PaletteColor 4, RGB32(50, 80, 0) ' yellow green
PaletteColor 5, RGB32(255, 255, 0) ' yellow
PaletteColor 6, RGB32(0, 255, 255) ' blue green
PaletteColor 7, RGB32(255, 0, 255) ' violet
PaletteColor 8, RGB32(0, 150, 250) ' greenish blue
PaletteColor 9, RGB32(0, 230, 80) ' bluish green
PaletteColor 10, RGB32(200, 200, 255) ' bluish white
PaletteColor 11, RGB32(0, 0, 70) 'very dark blue
PaletteColor 12, RGB32(255, 0, 0) ' red
PaletteColor 13, RGB32(0, 0, 255) ' blue
PaletteColor 14, RGB32(0, 0, 220) ' blue2
PaletteColor 15, RGB32(0, 0, 200) ' blue3
PaletteColor 16, RGB32(180, 0, 0) ' red2
PaletteColor 17, RGB32(90, 0, 0) ' red3
PaletteColor 18, RGB32(0, 180, 0) ' green2
PaletteColor 19, RGB32(0, 90, 0) ' green3
PaletteColor 20, RGB32(180, 0, 180) ' violet2
PaletteColor 21, RGB32(90, 0, 90) ' violet3
PaletteColor 22, RGB32(0, 70, 70) ' bluegreen2
PaletteColor 23, RGB32(0, 120, 120) ' bluegreen3
PaletteColor 24, RGB32(0, 0, 170) ' blue4
PaletteColor 25, RGB32(0, 0, 140) ' blue5
PaletteColor 26, RGB32(0, 0, 120) ' blue6
PaletteColor 27, RGB32(220, 0, 0) ' red4
PaletteColor 28, RGB32(140, 0, 0) ' red5
PaletteColor 29, RGB32(0, 220, 0) ' green4
PaletteColor 30, RGB32(0, 140, 0) ' green5
PaletteColor 31, RGB32(220, 0, 220) ' violet4
PaletteColor 32, RGB32(140, 0, 140) ' violet5
PaletteColor 33, RGB32(0, 180, 180) ' bluegreen4
PaletteColor 34, RGB32(0, 220, 220) ' bluegreen5
PaletteColor 35, RGB32(150, 150, 150) ' gray
PaletteColor 36, RGB32(90, 90, 90) ' dark gray
PaletteColor 37, RGB32(100, 100, 220) ' bluishbrown
PaletteColor 38, RGB32(200, 100, 100) ' redish brown
PaletteColor 39, RGB32(100, 200, 100) ' greenish brown
PaletteColor 40, RGB32(200, 100, 200) ' violet brown
PaletteColor 41, RGB32(0, 50, 0) ' green6
PaletteColor 42, RGB32(40, 0, 40) ' violet6
PaletteColor 43, RGB32(40, 0, 40) ' bluegreen6
PaletteColor 44, RGB32(180, 180, 100) ' yellow brown
PaletteColor 45, RGB32(200, 200, 255) 'off white
End Sub
Sub snd (sd)
' tempo "T80" length of note "L8"
'If sd = 1 Then Play "L8": Play "T40": Play "c"
If sd = 1 Then
Sound 160, 1
Sound 80, 1
End If
If sd = 2 Then
Sound 180, 1
Sound 90, 1
End If
If sd = 3 Then
Sound 200, 1
Sound 100, 1
End If
If sd = 20 Then
For x = 1 To 5
Sound 1000, 1
Sound 1000 - 100 * x, 1
Next
End If
End Sub
