error :
my cube is not drawn good
the code does not stop at "q"
Code: Select all
'' bluatigro 8 jun 2018
'' rubix 6 2
#include "color.bas"
#include "_text.bas"
dim shared as ulong kl( 6 * 4 )
sub rot4( a as integer _
, b as integer , c as integer , d as integer )
dim as ulong help = kl( a )
kl( a ) = kl( b )
kl( b ) = kl( c )
kl( c ) = kl( d )
kl( d ) = help
end sub
function qq( face as integer , poly as integer ) as integer
return face * 4 + poly
end function
''02
''13
'' 4
''0123
'' 5
sub rotj
rot4 qq( 4 , 0 ) , qq( 2 , 2 ) , qq( 5 , 3 ) , qq( 0 , 1 )
rot4 qq( 4 , 2 ) , qq( 2 , 3 ) , qq( 5 , 1 ) , qq( 0 , 0 )
rot4 qq( 3 , 0 ) , qq( 3 , 2 ) , qq( 3 , 3 ) , qq( 3 , 1 )
end sub
sub rotk
rot4 qq( 0 , 1 ) , qq( 1 , 1 ) , qq( 2 , 1 ) , qq( 3 , 1 )
rot4 qq( 0 , 3 ) , qq( 1 , 3 ) , qq( 2 , 3 ) , qq( 3 , 3 )
rot4 qq( 5 , 0 ) , qq( 5 , 2 ) , qq( 5 , 3 ) , qq( 5 , 1 )
end sub
sub rotl
rot4 qq( 4 , 2 ) , qq( 1 , 2 ) , qq( 5 , 2 ) , qq( 3 , 1 )
rot4 qq( 4 , 3 ) , qq( 1 , 3 ) , qq( 5 , 3 ) , qq( 3 , 0 )
rot4 qq( 2 , 0 ) , qq( 2 , 2 ) , qq( 2 , 3 ) , qq( 2 , 1 )
end sub
sub shufle
dim as string in
dim as integer level , i
cls
locate 20 , 20
input "how many shufles ? " ; in
level = val( in )
for i = 1 to level
select case int( rnd * 3 )
case 0
rotj
case 1
rotk
case 2
rotl
case else
end select
next i
end sub
screen 20 , 32
sub resetcube
dim as integer i , j
dim as ulong help
restore
for i = 0 to 5
read help
for j = 0 to 3
kl( qq( i , j ) ) = help
next j
next i
end sub
data red,green,cyan,magenta,blue,yellow
dim as integer i
dim as string in
resetcube
do
cls
for j = 0 to 1
for k = 0 to 1
line ( 100 + j * 50 , k * 50 ) _
- step( 45 , 45 ) , kl( qq( 4 , j * 2 + k ) ) , bf
next k
next j
for j = 0 to 1
for k = 0 to 1
line ( 100 + j * 50 , k * 50 + 200 ) _
- step( 45 , 45 ) , kl( qq( 5 , j * 2 + k ) ) , bf
next k
next j
for i = 0 to 3
for j = 0 to 1
for k = 0 to 1
line ( i * 100 + j * 50 , k * 50 + 100 ) _
- step( 45 , 45 ) , kl( qq( i , j * 2 + k ) ) , bf
next k
next j
next i
text 225 , 25 , "j" , 4 , white
text 425 , 175 , "k" , 4 , white
text 175 , 325 , "l" , 4 , white
text 512 , 550 , "[ s to shuffle ]" , 4 , white
text 512 , 600 , "[ r to reset ]" , 4 , white
text 512 , 650 , "[ q to quit ]" , 4 , white
locate 27 , 20
input "choise [ j , k , l , q , r , s ] = " ; in
select case in
case "j"
rotj
case "k"
rotk
case "l"
rotl
case "r"
resetcube
case "s"
shufle
case else
end select
loop until in = "q"
sleep
Code: Select all
''bluatigro 13 feb 2015
''color.bas
''some colors consts + functions
#ifndef COLOR_H
#define COLOR_H
#include "math.bas"
''primary colors
const as ulong black = &hff000000
const as ulong red = &hffff0000
const as ulong green = &hff00ff00
const as ulong yellow = &hffffff00
const as ulong blue = &hff0000ff
const as ulong magenta = &hffff00ff
const as ulong cyan = &hff00ffff
const as ulong white = &hffffffff
''mix colors
const as ulong orange = &hffff7f00
const as ulong gray = &hff7f7f7f
const as ulong pink = &hffff7f7f
const as ulong purple = &hff7f007f
const as ulong darkRed = &hff7f0000
const as ulong darkYellow = &hff7f7f00
const as ulong darkGreen = &hff007f00
const as ulong darkBlue = &hff00007f
function mix( kla as ulong , f as single , klb as ulong ) as ulong
dim as ulong ra , ga , ba , rb , gb , bb , r , g , b
ra = ( kla shr 16 ) and 255
ga = ( kla shr 8 ) and 255
ba = kla and 255
rb = ( klb shr 16 ) and 255
gb = ( klb shr 8 ) and 255
bb = klb and 255
r = ra + ( rb - ra ) * f
g = ga + ( gb - ga ) * f
b = ba + ( bb - ba ) * f
return rgb( r and 255 , g and 255 , b and 255 )
end function
function rainbow( x as single ) as ulong
dim as ulong r , g , b
r = sin( rad( x ) ) * 127 + 128
g = sin( rad( x - 120 ) ) * 127 + 128
b = sin( rad( x + 120 ) ) * 127 + 128
return rgb( r and 255 , g and 255 , b and 255 )
end function
function rndcolor() as ulong
return rgb( rnd * 255 , rnd * 255 , rnd * 255 )
end function
#endif
Code: Select all
''text
dim shared as integer letterpart( 40 , 7 )
dim as integer j , k
const as string letters = "abcdefghijklmnopqrstuvwxyz0123456789[]="
dim as string q
for i as byte = 1 to len( letters )
for j = 0 to 7
read q
for k = 0 to 7
if mid( q , k + 1 , 1 ) = "1" then
letterpart( i , j ) = letterpart( i , j ) or 2 ^ k
end if
next k
next j
next i
''a
data "...1...."
data "..111..."
data ".1...1.."
data "1.....1."
data "1111111."
data "1.....1."
data "1.....1."
data "1.....1."
''b
data "1111...."
data "1...1..."
data "1....1.."
data "1....1.."
data "111111.."
data "1.....1."
data "1.....1."
data "111111.."
''c
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data "1......."
data "1.....1."
data ".1...1.."
data "..111..."
''d
data "11111..."
data "1....1.."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1....1.."
data "11111..."
''e
data "1111111."
data "1.....1."
data "1......."
data "1......."
data "111111.."
data "1......."
data "1.....1."
data "1111111."
''f
data "1111111."
data "1.....1."
data "1......."
data "1......."
data "111111.."
data "1......."
data "1......."
data "1......."
''g
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data "1...111."
data "1.....1."
data ".1...1.."
data "..111..."
''h
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1111111."
data "1.....1."
data "1.....1."
data "1.....1."
''i
data "..111..."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "..111..."
''j
data "..111..."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "1..1...."
data "1..1...."
data ".11...."
''k
data "1......."
data "1.....1."
data "1....1.."
data "1...1..."
data "1111...."
data "1...1..."
data "1....1.."
data "1.....1."
''l
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1111111."
''m
data "1.....1."
data "11...11."
data "1.1.1.1."
data "1..1..1."
data "1..1..1."
data "1.....1."
data "1.....1."
data "1.....1."
''n
data "1.....1."
data "11....1."
data "1.1...1."
data "1..1..1."
data "1..1..1."
data "1...1.1."
data "1....11."
data "1.....1."
''o
data "..111..."
data ".1...1.."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".1...1.."
data "..111..."
''p
data "11111..."
data "1....1.."
data "1.....1."
data "1....1.."
data "11111..."
data "1.....,."
data "1......."
data "1......."
''q
data "..111..."
data ".1...1.."
data "1.....1."
data "1.....1."
data "1..1..1."
data "1...1.1."
data ".1...1.."
data "..111.1."
''r
data "11111..."
data "1....1.."
data "1.....1."
data "1....1.."
data "111111.."
data "1...1..."
data "1....1.."
data "1.....1."
''s
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data ".11111.."
data "......1."
data "1.....1."
data ".11111.."
''t
data "1111111."
data "1..1..1."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "..111..."
''u
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
''v
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".1...1.."
data "..1.1..."
data "...1...."
''w
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1..1..1."
data "1.1.1.1."
data "11...11."
data "1.....1."
''x
data "1.....1."
data ".1...1.."
data "..1.1.."
data "...1...."
data "...1...."
data "..1.1..."
data ".1...1.."
data "1.....1."
''y
data "1.....1."
data ".1...1.."
data "..1.1.."
data "...1...."
data "...1...."
data "..1....."
data ".1......"
data "1......."
''z
data "1111111."
data ".....1.."
data "....1..."
data "...1...."
data "...1...."
data "..1....."
data ".1......"
data "1111111."
''0
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data "........"
data "1.....1."
data "1.....1."
data ".11111.."
''1
data "........"
data "......1."
data "......1."
data "......1."
data "........"
data "......1."
data "......1."
data "........"
''2
data ".11111.."
data "......1."
data "......1."
data "......1."
data ".11111.."
data "1......."
data "1......."
data ".11111.."
''3
data ".11111.."
data "......1."
data "......1."
data "......1."
data ".11111.."
data "......1."
data "......1."
data ".11111.."
''4
data "........"
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "......1."
data "......1."
data "........"
''5
data ".11111.."
data "1......."
data "1......."
data "1......."
data ".11111.."
data "......1."
data "......1."
data ".11111.."
''6
data ".11111.."
data "1......."
data "1......."
data "1......."
data ".11111.."
data "1.....1."
data "1.....1."
data ".11111.."
''7
data ".11111.."
data "......1."
data "......1."
data "......1."
data "........"
data "......1."
data "......1."
data "........"
''8
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "1.....1."
data "1.....1."
data ".11111.."
''9
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "......1."
data "......1."
data ".11111.."
''[
data "..1111.."
data "..1....."
data "..1....."
data "..1....."
data "..1....."
data "..1....."
data "..1....."
data "..1111.."
'']
data "..1111..."
data ".....1.."
data ".....1.."
data ".....1.."
data ".....1.."
data ".....1.."
data ".....1.."
data "..1111.."
''=
data "........"
data "........"
data "..1111.."
data "........"
data "........"
data "..1111.."
data "........"
data "........"
sub digit( x as integer , y as integer , b as integer , d as double , kl as ulong )
dim as integer i , j
for i = 0 to 7
for j = 0 to 7
if ( letterpart( b , i ) and 2 ^ j ) <> 0 then
circle ( x + j * d - 3 * d , y + i * d - 3 * d ) , d / 2 , kl ,,,, f
end if
next j
next i
end sub
const as ulong transparent = &h1000000
sub text( x as integer , y as integer _
, t as string , d as double _
, kl as ulong , bkl as ulong = transparent )
dim as integer i , l = len( t )
if bkl < transparent then
line ( x - l * 4 * d + d * 4 , y - 4 * d ) _
- step ( l * 8 * d - d * 4 , 9 * d ) , bkl , bf
end if
for i = 1 to l
digit x + i * 8 * d - l * 4 * d - 4 * d , y _
, instr( letters , lcase( mid( t , i , 1 ) ) ) , d , kl
next i
end sub