"Fossies" - the Fresh Open Source Software Archive

Member "blassic-0.11.0/puzzle.bas" (15 Feb 2006, 9610 Bytes) of package /linux/privat/blassic-0.11.0.tgz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Visual Basic source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 rem *********************************
    2 rem puzzle.bas
    3 rem *********************************
    4 
    5 rem def int a-z
    6 
    7 'open "t.t" for output as #1
    8 'tron line #1
    9 
   10 if_debug 1: e= 10: open error as 10
   11 
   12 on error goto hay_error
   13 
   14 rem Cambiar esto de acuerdo a gustos o necesidades del sistema
   15 default_zoom= 2
   16 
   17 rem Para probar varias formas
   18 usa_scroll= not 0
   19 usa_paint= 0
   20 despacio= 0
   21 
   22 arg= 1
   23 
   24 label otro_arg
   25 
   26 arg$= programarg$ (arg)
   27 
   28 if arg$ = "-paint" then usa_paint= not 0: arg= arg + 1: goto otro_arg
   29 
   30 if arg$ = "-put" then usa_scroll= 0: arg= arg + 1: goto otro_arg
   31 
   32 if arg$ = "-slow" then despacio= val (programarg$ (arg + 1) ): arg= arg + 2: goto otro_arg
   33 
   34 zoom= val (arg$)
   35 if zoom = 0 then zoom = default_zoom
   36 
   37 xpart= val (programarg$ (arg + 1) )
   38 ypart= val (programarg$ (arg + 2) )
   39 if xpart = 0 then xpart= 5
   40 if ypart = 0 then ypart= 4
   41 
   42 if xpart * ypart > 100 then print "Valores inadecuados, se admiten 100 numeros como mucho": exit 1
   43 
   44 dim solucion (xpart, ypart)
   45 dim tablero (xpart, ypart)
   46 
   47 n= 1
   48 for y= 1 to ypart
   49     for x= 1 to xpart
   50         solucion (x, y)= n
   51         n= n + 1
   52     next
   53 next
   54 solucion (xpart, ypart)= 0
   55 
   56 gosub define_funciones
   57 
   58 rem Dimensiones de cada pieza del puzzle
   59 xpieza= 21 * zoom
   60 ypieza= 13 * zoom
   61 
   62 anchotab= xpart * xpieza + zoom
   63 altotab= ypart * ypieza + zoom
   64 
   65 pixchar= 8 * zoom
   66 anchotex= 13 * pixchar
   67 altotex= 5 * pixchar
   68 
   69 ancho= max (anchotab, anchotex)
   70 alto= max (altotab, altotex)
   71 
   72 xoff= (ancho - anchotab) \ 2
   73 yoff= (alto - altotab) \ 2
   74 
   75 xcoff= (ancho - anchotex) \ (pixchar * 2)
   76 ycoff= (alto - altotex) \ (pixchar * 2)
   77 
   78 fondo= 14
   79 border fondo
   80 border width zoom * 2
   81 
   82 rem El IF es para compatibilidad descendente cuando se usa zoom 1
   83 if zoom = 1 then mode ancho, alto else mode ancho, alto, 0, zoom, zoom
   84 
   85 esc$= chr$ (27)
   86 
   87 transp$= chr$ (22) + chr$ (1)
   88 notransp$= chr$ (22) + chr$ (0)
   89 
   90 paper fondo
   91 graphics paper fondo
   92 graphics cls
   93 print transp$;
   94 
   95 
   96 repeat
   97     print at ycoff + 0, xcoff + 3; "PUZZLE"
   98     print at ycoff + 2, xcoff + 0; "ESC --> Fin"
   99     print at ycoff + 4, xcoff + 0; "Otra--> jugar";
  100     clear input
  101 
  102     label pide_opcion
  103     repeat
  104         get opcion$
  105     until opcion$ <> "RELEASE"
  106     if opcion$ <> "CLICK" then goto elegido
  107 
  108     y= int (ymouse / 8 / zoom) - ycoff
  109     repeat
  110         get t$
  111     until t$ = "RELEASE"
  112     if y = 2 then opcion$= esc$ else if y <> 4 then goto pide_opcion
  113 
  114     label elegido
  115     graphics cls
  116     if opcion$ <> esc$ then gosub partida
  117 
  118 until opcion$ = esc$
  119 
  120 end
  121 
  122 rem ******************************************
  123     label partida
  124 rem ******************************************
  125 
  126 tag
  127 gosub barajar
  128 gosub pinta_tablero
  129 ganador= 0
  130 inicio= time
  131 
  132 repeat
  133     get a$
  134     if a$ ="r" then gosub pinta_tablero
  135     if a$ = "CLICK" then gosub raton
  136     if a$ = "LEFT" then void= fn izquierda (1)
  137     if a$ = "RIGHT" then void= fn derecha (1)
  138     if a$ = "UP" then void= fn arriba (1)
  139     if a$ = "DOWN" then void= fn abajo (1)
  140 
  141     tablero (xblanco, yblanco)= 0
  142 
  143     if fn victoria then ganador=1: a$= esc$
  144 until a$ = esc$
  145 
  146 tiempo= time - inicio
  147 tiempo$= trim$ (str$ (tiempo) )
  148 post= 5 - (len (tiempo$) - 1) \ 2
  149 
  150 tagoff
  151 
  152 graphics cls
  153 
  154 if ganador = 0 then return
  155 
  156 beep
  157 
  158 for j= 1 to 2
  159     for i= 15 to 0 step -1
  160         if i = fondo then goto gana_next
  161         pen i
  162         print at ycoff + 1, xcoff + 1; "HAS GANADO"
  163         print at ycoff + 3, xcoff + 3; "Tiempo"
  164         print at ycoff + 4, xcoff + post; tiempo$
  165         pause 100
  166         label gana_next
  167     next
  168 next
  169 beep
  170 clear input
  171 get a$
  172 graphics cls
  173 
  174 return ' Partida
  175 
  176 
  177 label raton
  178 
  179 xx= xmouse - xoff: yy= ymouse - yoff
  180 x= int (xx / xpieza) + 1
  181 y= int (yy / ypieza) + 1
  182 if x > xpart or y > ypart then goto fin_raton
  183 
  184 if yblanco = y then goto horizontal else goto vertical
  185 
  186 label horizontal
  187 
  188 if xblanco = x then goto fin_raton
  189 
  190 if xblanco > x then goto derecha
  191 
  192 void= fn izquierda (x - xblanco)
  193 
  194 goto fin_raton
  195 
  196 label derecha
  197 
  198 void= fn derecha (xblanco - x)
  199 
  200 goto fin_raton
  201 
  202 label vertical
  203 
  204 if xblanco <> x then goto  fin_raton
  205 if yblanco = y then goto fin_raton
  206 if yblanco > y then goto abajo
  207 
  208 void= fn arriba (y - yblanco)
  209 
  210 goto fin_raton
  211 
  212 label abajo
  213 
  214 void= fn abajo (yblanco - y)
  215 
  216 label fin_raton
  217 
  218 return
  219 
  220 
  221 rem ****************************************
  222     label define_funciones
  223 rem ****************************************
  224 
  225 def fn xx (x)= (x - 1) * xpieza + xoff
  226 def fn yy (y)= (y - 1) * ypieza + yoff
  227 
  228 rem ****************************************
  229     def fn izquierda (n)
  230 rem ****************************************
  231 
  232 if xblanco + n > xpart then fn return
  233 
  234 for i= xblanco to xblanco + n - 1
  235     tablero (i, yblanco)= tablero (i + 1, yblanco)
  236 next
  237 void= fn move_izq (xblanco + 1, yblanco, n)
  238 
  239 xblanco= xblanco + n
  240 
  241 fn end
  242 
  243 rem ****************************************
  244     def fn derecha (n)
  245 rem ****************************************
  246 
  247 if xblanco - n < 1 then fn return
  248 
  249 for i= xblanco to xblanco - n step -1
  250     tablero (i, yblanco)= tablero (i - 1, yblanco)
  251 next
  252 void= fn move_der (xblanco - n, yblanco, n)
  253 
  254 xblanco= xblanco - n
  255 
  256 fn end
  257 
  258 rem ****************************************
  259     def fn arriba (n)
  260 rem ****************************************
  261 
  262 if yblanco + n > ypart then fn return
  263 
  264 for i= yblanco to yblanco + n - 1
  265     tablero (xblanco, i)= tablero (xblanco, i + 1)
  266 next
  267 void= fn move_arr (xblanco, yblanco + 1, n)
  268 
  269 yblanco= yblanco + n
  270 
  271 fn end
  272 
  273 rem ****************************************
  274     def fn abajo (n)
  275 rem ****************************************
  276 
  277 if yblanco - n < 1 then fn return
  278 
  279 for i= yblanco to yblanco - n step - 1
  280     tablero (xblanco, i)= tablero (xblanco, i - 1)
  281 next
  282 void= fn move_abj (xblanco, yblanco - n, n)
  283 
  284 yblanco= yblanco - n
  285 
  286 fn end
  287 
  288 rem ****************************************
  289     def fn move_izq (x, y, n)
  290 rem ****************************************
  291 
  292 local xx, yy, xx2, yy2, i
  293 
  294 if_debug 1 : print #e, x, y, n
  295 
  296 xx= fn xx (x)
  297 yy= fn yy (y)
  298 xx2= xx + (xpieza * n) 
  299 yy2= yy + ypieza
  300 
  301 if not usa_scroll then get (xx, yy)-(xx2, yy2), g
  302 
  303 for i= xx - zoom to xx - xpieza step -zoom
  304     if usa_scroll then graphics scroll xx - xpieza, yy, xx2, yy2, -zoom, 0 else put (i, yy), g
  305     if despacio then pause despacio
  306 next
  307 
  308 fn end
  309 
  310 rem ****************************************
  311     def fn move_der (x, y, n)
  312 rem ****************************************
  313 
  314 local xx, yy, xx2, yy2, i
  315 
  316 if_debug 1 : print #e, x, y, n
  317 
  318 xx= fn xx (x)
  319 yy= fn yy (y)
  320 xx2= xx + (xpieza * n) 
  321 yy2= yy + ypieza
  322 
  323 if not usa_scroll then get (xx, yy)-(xx2, yy2), g
  324 
  325 for i= xx + zoom to xx + xpieza step zoom
  326     if usa_scroll then graphics scroll xx, yy, xx2 + xpieza, yy2, zoom, 0 else put (i, yy), g
  327     if despacio then pause despacio
  328 next
  329 
  330 fn end
  331 
  332 rem ****************************************
  333     def fn move_arr (x, y, n)
  334 rem ****************************************
  335 
  336 local xx, yy, xx2, yy2, i
  337 
  338 xx= fn xx (x)
  339 yy= fn yy (y)
  340 xx2= xx + xpieza
  341 yy2= yy + (ypieza * n)
  342 
  343 if not usa_scroll then get (xx, yy)-(xx2, yy2), g
  344 
  345 for i= yy - zoom to yy - ypieza step -zoom
  346     if usa_scroll then graphics scroll xx, yy - ypieza, xx2, yy2, 0, -zoom else put (xx, i), g
  347     if despacio then pause despacio
  348 next
  349 
  350 fn end
  351 
  352 rem ****************************************
  353     def fn move_abj (x, y, n)
  354 rem ****************************************
  355 
  356 local xx, yy, xx2, yy2, i
  357 
  358 xx= fn xx (x)
  359 yy= fn yy (y)
  360 xx2= xx + xpieza
  361 yy2= yy + (ypieza * n)
  362 
  363 if not usa_scroll then get (xx, yy)-(xx2, yy2), g
  364 
  365 for i= yy + zoom to yy + ypieza step zoom
  366     if usa_scroll then graphics scroll xx, yy, xx2, yy2 + ypieza, 0, zoom else put (xx, i), g
  367     if despacio then pause despacio
  368 next
  369 
  370 fn end
  371 
  372 rem ****************************************
  373     def fn pinta_pieza (x, y)
  374 rem ****************************************
  375 
  376 local p
  377 
  378 p= tablero (x, y)
  379 
  380 if p = 0 then fn return
  381 
  382 local xx, yy, xx2, yy2, z
  383 
  384 z= zoom
  385 xx= fn xx (x) + z
  386 yy= fn yy (y) + z
  387 xx2= fn xx (x) + xpieza - z
  388 yy2= fn yy (y) + ypieza - z
  389 
  390 graphics pen 0
  391 
  392 line (xx, yy) - (xx2, yy2), , bf
  393 
  394 if usa_paint then graphics pen 15 else graphics pen 3
  395 
  396 line (xx + zoom, yy + zoom) - (xx2 - zoom, yy2 - zoom), , bf
  397 
  398 if usa_paint then paint (xx + zoom + 1, yy + zoom + 1), 3, 0
  399 
  400 graphics pen 0
  401 xnum= xx + 2 * zoom
  402 if p < 10 then xnum= xnum + pixchar \ 2
  403 move xnum, yy + 2 * zoom
  404 print trim$ (str$ (p) );
  405 
  406 'if usa_paint then paint (xx + zoom + 1, yy + zoom + 1), 3, 0
  407 
  408 fn end
  409 
  410 rem ****************************************
  411     def fn victoria
  412 rem ****************************************
  413 
  414 local x, y
  415 
  416 victoria= 1
  417 
  418 for y= 1 to ypart
  419     for x= 1 to xpart
  420         if tablero (x, y) <> solucion (x, y) then victoria= 0
  421 next x, y
  422 
  423 fn end
  424 
  425 return ' define_funciones
  426 
  427 rem ****************************************
  428     label pinta_tablero
  429 rem ****************************************
  430 
  431 graphics cls
  432 
  433 local x, y
  434 
  435 for y= 1 to ypart
  436     for x= 1 to xpart
  437         void= fn pinta_pieza (x, y)
  438     next
  439 next
  440 
  441 return
  442 
  443 rem ****************************************
  444     label inicia_tablero
  445 rem ****************************************
  446 
  447 local y
  448 
  449 for y= 1 to ypart
  450     for x= 1 to xpart
  451         tablero (x, y)= solucion (x, y)
  452     next
  453 next
  454 
  455 return
  456 
  457 rem ****************************************
  458     label barajar
  459 rem ****************************************
  460 
  461 randomize time
  462 
  463 gosub inicia_tablero
  464 
  465 x= xpart
  466 y= ypart
  467 
  468 for b= 1 to 500
  469     j= 1 + int (rnd * 4)
  470     on j gosub barizq, barder, bararr, baraba
  471 next
  472 
  473 xblanco= x: yblanco= y
  474 
  475 return
  476 
  477 label barizq
  478 if x = 1 then return
  479 tablero (x, y)= tablero (x - 1, y)
  480 x= x - 1
  481 tablero (x, y) = 0
  482 return
  483 
  484 label barder
  485 if x = xpart then return
  486 tablero (x, y)= tablero (x + 1, y)
  487 x= x + 1
  488 tablero (x, y)= 0
  489 return
  490 
  491 label bararr
  492 if y = 1 then return
  493 tablero (x, y)= tablero (x, y - 1)
  494 y= y - 1
  495 tablero (x, y)= 0
  496 return
  497 
  498 label baraba
  499 if y = ypart then return
  500 tablero (x, y)= tablero (x, y + 1)
  501 y= y + 1
  502 tablero (x, y)= 0
  503 return
  504 
  505 label hay_error
  506 on error goto 0
  507 mode 0
  508 print "Error: "; strerr$ (err); " en linea "; erl
  509 end
  510 
  511 rem **************************************
  512 rem Fin de puzzle.bas
  513 rem **************************************