Jogo de truco em clipper summer 87

[Daniel]

Ola
Encontrei nos disquetes antigo um programa que fiz a muito tempo, acho que foi feito no xt 286
Compilei em harbour não e que funciona ainda (rs,rs)

[JoséQuintas]

Legal.

Aproveitei pra fazer um este com aquele meu formatador simples...
Até que o resultado tá bom.

truco.zip

(5.95 KiB) Baixado 36 vezes

[JoséQuintas]

Estou brincando com esse fonte, apesar de não saber nada de truco.
Tem uma parte do fonte esquisita, não sei se está certa ou errada.
Direto depois da alteração, assim serve pra relembrar.... rs

Código: Selecionar todos

   CASE local = 1
      cart( 19, 1, 23, 8, "clara", CartaNaipe( A ), "x" )
      cart( 9, ycol1, 13, ycol1 + 5, CartaSimbolo( A ), CartaNaipe( A ), "a" )
   CASE local = 2
      cart( 19, 10, 23, 17, "clara", CartaNaipe( B ), "x" )
      cart( 9, ycol1, 13, ycol1 + 5, CartaSimbolo( B ), CartaNaipe( B ), "b" )
   CASE local = 3
      cart( 19, 19, 23, 26, "clara", CartaNaipe( C ), "x" )
      cart( 09, ycol1, 13, ycol1 + 5, CartaSimbolo( C ), CartaNaipe( D ), "c" )
   CASE local = 4
      cart( 19, 53, 23, 59, "clara", CartaNaipe( E ), "x" )
      cart( 09, ycol1, 13, ycol1 + 5, CartaSimbolo( E ), CartaNaipe( E ), "e" )
   CASE local = 5
      cart( 19, 62, 23, 68, "clara", CartaNaipe( F ), "x" )
      cart( 09, ycol1, 13, ycol1 + 5, CartaSimbolo( F ), CartaNaipe( F ), "f" )
   CASE local = 6
      cart( 19, 71, 23, 77, "clara", CartaNaipe( G ), "x" )
      cart( 09, ycol1, 13, ycol1 + 5, CartaSimbolo( G ), CartaNaipe( G ), "g" )
   ENDCASE

Está confusa a parte de carta C e D, porque é a única que mistura.
Por outro lado, vai de 1 a 6, mas são 7 cartas.

[JoséQuintas]

É interessante como até o fonte de um jogo pode responder dúvidas de alguns....
Tive que retirar os efeitos, pra facilitar, mas... usando PTBR

Código: Selecionar todos

REQUEST HB_CODEPAGE_PTISO

FUNCTION Main()

   PUBLIC pontoxc, pontoxh

   Set( _SET_CODEPAGE, "PTISO"  )

[JoséQuintas]

Usei 2 linhas, ao invés do fonte de moldura, mas ficou sem o efeito 3d que tinha antes.

Código: Selecionar todos

STATIC FUNCTION molduratest( xl, xc, xl2, xc2 )

   @ xl, xc CLEAR TO xl2, xc2
   @ xl, xc TO xl2, xc2
/*
   LOCAL XCOR, XCOR1, XONDE, XONDE2, XC3, XA

   xcor = SetColor()
   xonde = ( At( "/", xcor ) + 1 )
   xonde2 = ( At( ",", xcor ) - xonde )
   xcor1 = subs( xcor, xonde, xonde2 ) +  "+/" + SUBS( XCOR, XONDE )
   xc3 = ( xc2 - 1 - xc )
   SET COLOR TO ( XCOR1 )
   @ xl, xc - 1 CLEAR TO xl2, xc2 + 1
   @ xl, xc SAY "Ú" + replic( "Ä", xc3 )
   xa = xl + 1
   DO WHILE xa < xl2
      @ xa, xc SAY "³ "
      xa = xa + 1
   ENDDO
   IF subs( xcor, xonde, 1 ) = "N" .OR. subs( xcor1, xonde, 1 ) = "n"
      XCOR1 = "W/" + SUBS( XCOR, XONDE )
   ELSE
      XCOR1 = "N/" + SUBS( XCOR, XONDE )
   ENDIF
   SET COLOR TO ( XCOR1 )
   @ xl2, xc SAY "À" + replic( "Ä", xc3 ) + "Ù"
   xa = xa - 1
   DO WHILE xa > xl
      @ xa, xc2 - 1 SAY " ³"
      xa = xa - 1
   ENDDO
   @ xl, xc2 SAY "¿"
   @ xl + 1, xc + 1 CLEAR TO xl2 - 1, xc2 - 1
   SET COLOR TO ( xcor )
*/

   RETURN NIL

[JoséQuintas]

O que mencionei antes, também dei uma mexida.
Acho que pra truco o naipe não faz diferença, por isso o bug não fazia diferença.

[JoséQuintas]

O fonte se alterou um pouco.
E usando GTWVG dá pra redimensionar a tela.
Precisa refazer o fonte pra usar imagens, mas anexei imagens de um baralho completo.

truco.zip

(145.19 KiB) Baixado 42 vezes

(nota: editado, fotos colocadas depois, mas estavam duplicadas)

[JoséQuintas]

Uia... um teste rápido com GTWVG.

Como eu digo sempre, é organizar antes de complicar.
Mas foi só teste, as imagens não se mantém... rs

Só troquei a rotina que desenha carta.

Código: Selecionar todos

STATIC FUNCTION DesenhaCarta( nTop, nLeft, cTipo, nNumeroCarta )

   LOCAL aImagemList, cImagem, nBottom, nRight // cCorOld, nBottom, nRight

   nBottom := nTop + 4
   nRight  := nLeft + 6

   aImagemList := Directory( "imagem\*.jpg" )
   aSort( aImagemList, , , { | a, b | a[ 1 ] < b[ 1 ] } )
   IF nNumeroCarta == NIL .OR. nNumeroCarta < 1 .OR. nNumeroCarta > 52 .AND. cTipo == cTipo // so pra nao dar erro
      cImagem := aImagemList[ 53, 1 ]
   ELSE
      cImagem := aImagemList[ nNumeroCarta, 1 ]
   ENDIF
   wvt_DrawImage( nTop, nLeft, nBottom, nRight, "imagem\" + cImagem )
   /*

   cCorOld = SetColor()
   SET COLOR TO R/W
   DO CASE
   CASE cTipo == "escura"
      molduratest( nTop, nLeft, nBottom, nRight )
      FOR xlc = nTop + 1 TO nBottom - 1
         @ xlc, nLeft + 1, xlc, nLeft + 5 BOX Replicate( Chr(176), 9 ) //  SAY replicate( hb_UTFToStr( Chr(176) ), 5 ) // "±", 5 )
      NEXT
   CASE cTipo == "clara"
      SET COLOR TO N/W
      @ nTop, nLeft CLEAR TO nBottom, nRight
   OTHERWISE
      IF nTop < 10
         IF cTipo = "e" .OR. cTipo = "f" .OR. cTipo = "g"
            SET COLOR TO W+/R
            @ nTop - 1, nLeft + 1 SAY "Hum."
         ELSE
            SET COLOR TO GR+/R
            @ nTop - 1, nLeft + 1 SAY "Comp."
         ENDIF
      ENDIF
      IF CartaNaipe( nNumeroCarta ) = 3 .OR. CartaNaipe( nNumeroCarta ) = 4
         SET COLOR TO R/W
      ELSE
         SET COLOR TO N/W
      ENDIF
      molduratest( nTop, nLeft, nBottom, nRight )
      @ nTop + 1,    nLeft+ 1   SAY CartaSimbolo( nNumeroCarta )
      @ nTop + 2,    nLeft + 3  SAY Chr( CartaNaipe( nNumeroCarta ) )
      @ nBottom - 1, nRight - 1 SAY CartaSimbolo( nNumeroCarta )
   ENDCASE
   // @ 3,0 say "va="+ltrim(str(va)) + " =" + ltrim(str(a))  && sete linhas para verifica‡Æo, retirar ap¢s teste
   // @ 4,0 say "vb="+ltrim(str(vb)) + " =" + ltrim(str(b))
   // @ 5,0 say "vc="+ltrim(str(vc)) + " =" + ltrim(str(c))
   // @ 6,0 say "vd="+ltrim(str(vd)) + " =" + ltrim(str(d))
   // @ 7,0 say "ve="+ltrim(str(ve)) + " =" + ltrim(str(e))
   // @ 8,0 say "vf="+ltrim(str(vf)) + " =" + ltrim(str(f))
   // @ 9,0 say "vg="+ltrim(str(vg)) + " =" + ltrim(str(g))
   SET COLOR TO ( cCorOld )
*/
   RETURN NIL

[JoséQuintas]

Funciona, só não pode mover a janela.
Aqui o jogo até o fim.

[janio]

Quintas parece q gostou da brincadeira hehehehe