à dessiner des chapeaux

Les derniers trucs auxquels vous avez joué, les derniers ordinateurs que vous avez bidouillés.

Modérateur : Politburo

Avatar du membre
jvernet
Fonctionne à 14400 bauds
Fonctionne à 14400 bauds
Messages : 7958
Enregistré le : 24 mai 2002 09:57
Localisation : France 69
Contact :

Re: à dessiner des chapeaux

Message par jvernet »

Une autre version, trouvé sur une vieille disquette datant de mes études, qui ressemblent un peu au autres, toujours pour Quick Basic:
Elle trace en fil de fer, mais sans face cachées.
Votre devoir: ajouter les faces cachées.
La encore, c'est pas bien foutu: fait deux fois le calcul, une fois pour trouver les limites, une fois pour tracer.

Code : Tout sélectionner

REM Surface
DECLARE SUB FindWindow ()
DECLARE SUB FindEyeCoordinates ()
DECLARE SUB FindScreenCoordinates ()
DECLARE SUB FindLimits ()
DECLARE FUNCTION Fun! (x AS SINGLE, y AS SINGLE)
CONST x1 = 0, y1 = 0, x2 = 639, y2 = 479
COMMON SHARED xMin  AS SINGLE, xMax AS SINGLE, yMin AS SINGLE, yMax AS SINGLE
COMMON SHARED x AS SINGLE, y AS SINGLE, dx AS SINGLE, dy AS SINGLE, Ax AS SINGLE, Ay AS SINGLE, Bx AS SINGLE, By AS SINGLE
COMMON SHARED dxMin AS SINGLE, dxMax AS SINGLE, dyMin AS SINGLE, dyMax AS SINGLE
COMMON SHARED xOld AS INTEGER, yOld AS INTEGER, xNew AS INTEGER, yNew AS INTEGER
COMMON SHARED Rad AS INTEGER, D AS INTEGER
COMMON SHARED sinT AS SINGLE, cosT AS SINGLE, sinP AS SINGLE, cosP AS SINGLE
CONST Big = 9.999999E+10, Margin = .1
REM DIM SHOW2 AS INTEGER


  xCount% = 30
  yCount% = 30
  xMin = -10
  xMax = 10
  yMin = -10
  yMax = 10
  Rad = 30
  Theta# = -.1
  Phi# = .8
  D = 10
  SCREEN 12
  COLOR 15
  CLS
  LINE (0, 0)-(639, 479), , B
  sinT = SIN(Theta#)
  cosT = COS(Theta#)
  sinP = SIN(Phi#)
  cosP = COS(Phi#)
  xStep# = (xMax - xMin) / xCount%
  yStep# = (yMax - yMin) / yCount%
  dxMin = Big
  dxMax = -Big
  dyMin = Big
  dyMax = -Big
  FOR SHOW2 = 0 TO -1 STEP -1
    FOR i% = 0 TO xCount%
      x = xMin + i% * xStep#
      y = yMin
       CALL FindEyeCoordinates
      IF SHOW2 THEN
        CALL FindScreenCoordinates
        xOld = xNew
        yOld = yNew
        PSET (xOld, yOld)
        ELSE CALL FindLimits
      END IF
      FOR j% = 0 TO yCount%
        y = yMin + j% * yStep#
        CALL FindEyeCoordinates
        IF SHOW2 THEN
          CALL FindScreenCoordinates
          LINE (xOld, yOld)-(xNew, yNew)
          xOld = xNew
          yOld = yNew
          ELSE CALL FindLimits
        END IF
      NEXT j%
    NEXT i%
    FOR i% = 0 TO yCount%
      y = yMin + i% * yStep#
      x = xMin
      CALL FindEyeCoordinates
      IF SHOW2 THEN
        CALL FindScreenCoordinates
        xOld = xNew
        yOld = yNew
        PSET (xOld, yOld)
        ELSE CALL FindLimits
      END IF
      FOR j% = 0 TO xCount%
        x = xMin + j% * xStep#
        CALL FindEyeCoordinates
        IF SHOW2 THEN
          CALL FindScreenCoordinates
          LINE (xOld, yOld)-(xNew, yNew)
          xOld = xNew
          yOld = yNew
          ELSE CALL FindLimits
        END IF
      NEXT j%
    NEXT i%
    IF NOT SHOW2 THEN CALL FindWindow
  NEXT SHOW2
  WHILE INKEY$ = "": WEND
  SCREEN 0: WIDTH 80, 25
END

SUB FindEyeCoordinates ()
  z# = Fun(x, y)
  xx = -x * sinT + y * cosT
  yy = -x * cosT * cosP - y * sinT * cosP + z# * sinP
  zz = -x * cosT * sinP - y * sinT * sinP - z# * cosP + Rad
  dx = D * xx / zz
  dy = D * yy / zz
END SUB

SUB FindLimits ()
  IF dx > dxMax THEN dxMax = dx
  IF dx < dxMin THEN dxMin = dx
  IF dy > dyMax THEN dyMax = dy
  IF dy < dyMin THEN dyMin = dy
END SUB

SUB FindScreenCoordinates ()
  xNew = FIX(Ax + Bx * dx)
  yNew = y2 - FIX(Ay + By * dy)
END SUB

SUB FindWindow ()
  xSize = dxMax - dxMin
  ySize = dyMax - dyMin
  dxMin = dxMin - Margin * xSize
  dxMax = dxMax + Margin * xSize
  dyMin = dyMin - Margin * ySize
  dyMax = dyMax + Margin * ySize
  Bx = (x2 - x1) / (dxMax - dxMin)
  By = (y2 - y1) / (dyMax - dyMin)
  Ax = x1 - dxMin * Bx
  Ay = y1 - dyMin * By
END SUB

FUNCTION Fun (x AS SINGLE, y AS SINGLE)
  Fun = COS(SQR(x * x + y * y))
REM     Fun = COS((EXP(x * x - y * y)))
END FUNCTION

"l'ordinateur et l'homme sont les deux opposés les plus intégraux qui existent. L'homme est lent, peu rigoureux et très intuitif. L'ordinateur est super rapide, très rigoureux et complètement con."
Ben
Fonctionne à 2400 bauds
Fonctionne à 2400 bauds
Messages : 1549
Enregistré le : 21 août 2016 19:04

Re: à dessiner des chapeaux

Message par Ben »

Il est pas beau celui-ci?
Sur le PC-1600
Sur le PC-1600
Chapeau2.jpg (97.9 Kio) Vu 8283 fois
Si on regarde bien, il n'est pas tout à fait le même que la version PB-700.
Avatar du membre
C.Ret
Fonctionne à 9600 bauds
Fonctionne à 9600 bauds
Messages : 3405
Enregistré le : 31 mai 2008 23:43
Localisation : N 49°22 E 6°10

Re: à dessiner des chapeaux

Message par C.Ret »

Moi aussi, je viens de refaire des chapeaux, mais avec l'APPLICATION 3D d'une TI-92 II c'est plus facile à programmer que sur d'autres systèmes:
3D on TI-92 II (1).gif
3D on TI-92 II (1).gif (95.27 Kio) Vu 7824 fois
3D on TI-92 II (2).gif
3D on TI-92 II (2).gif (145.64 Kio) Vu 7824 fois
SHARP PC-1211 PC-1360 EL-5150 PC-E500 | Commodore C=128D | Texas Instruments Ti-57LCD Ti-74BASICalc Ti-92II Ti-58c Ti-95PROCalc Ti-30XPROMathPrint | Hewlett-Packard HP-28S HP-41C HP-15C HP-Prime HP-71B | CASIO fx-602p | NUMWORKS | Graphoplex Rietz Neperlog | PockEmul | Sommaire des M.P.O. | Ma...dov'il sapone.
Ben
Fonctionne à 2400 bauds
Fonctionne à 2400 bauds
Messages : 1549
Enregistré le : 21 août 2016 19:04

Re: à dessiner des chapeaux

Message par Ben »

Ce ne serait pas un bon article pour la gazette? Comment dessiner des chapeaux avec les calculatrices :-)
Avatar du membre
Schraf
Fonctionne à 1200 bauds
Fonctionne à 1200 bauds
Messages : 499
Enregistré le : 05 mars 2020 20:45
Contact :

Re: à dessiner des chapeaux

Message par Schraf »

Je n'avais jamais lu ce fil datant d'il y a qq années, marrant, j'ai vu la première fois ce chapeau dans Sciences & Avenir Hors série n°36 et cela m'avait beaucoup marqué. Le code d'origine était visible dans une publicité pour le Commodore CBM.

La pub CBM + image de Sciences & Avenir
Programme Python pour la calculatrice NUMWORKS
Gilles59
Fonctionne à 2400 bauds
Fonctionne à 2400 bauds
Messages : 1602
Enregistré le : 27 oct. 2010 20:46

Re: à dessiner des chapeaux

Message par Gilles59 »

Schraf a écrit : 20 nov. 2022 12:28 Je n'avais jamais lu ce fil datant d'il y a qq années, marrant, j'ai vu la première fois ce chapeau dans Sciences & Avenir Hors série n°36 et cela m'avait beaucoup marqué. Le code d'origine était visible dans une publicité pour le Commodore CBM.

La pub CBM + image de Sciences & Avenir
Programme Python pour la calculatrice NUMWORKS
Super fil que j’avais loupé aussi. Ce chapeau était aussi dans un numéro de Microsystem une revue que j’aimais beaucoup dans les années 1980. Il y a avait une période très intéressante où ça parlait des langages comme le forth, lisp ou logo, système experts et IA. Dans une crise rangement j’ai tout bazardé il y pas mal d’années :/ ça doit être telechargeable mais c’est pas pareil. J’avais aussi programmé ca en Fortran pendant mes études. L’écran était vectoriel
(Comme la vectrex en bien plus grand!) et ça avait de la gueule car pas de pixelisation du tout. Ça ne rajeunit pas mdr. Mais je préférai écrire un puissance 4 sur Bull mini 6. Lol.
Casio FX-502P /602P / 603P / FX180P+ / FX4000P / TI57 / TI66 / TI74 Basicalc / TI95 Procalc / HP12C / HP15C LE / DM41L / HP 30B / HP39GII / HP 48SX USA / 49G / 49g+ / 50G / 50G NewRPL / HP Prime / Oric 1 / Amstrad CPC 6128+ CM14 et MM12 / Alice 32
Avatar du membre
Schraf
Fonctionne à 1200 bauds
Fonctionne à 1200 bauds
Messages : 499
Enregistré le : 05 mars 2020 20:45
Contact :

Re: à dessiner des chapeaux

Message par Schraf »

Merci @Gilles59, il faudra que je recherche dans les revues Microsystem, j'en ai qq unes, les autres existent en ligne.

Voici la traduction bête et méchante pour une TI-82 Plus (mais a priori pas de modifications à faire pour une TI-83) :

Code : Tout sélectionner

GridOff:LabelOff:AxesOff		// On enlève grille, labels et axes
Radian
0→Xmin:0→Ymin:320→Xmax:222→Ymax		// fenêtre graphique
ClrDraw
Shade(0,222		// Efface l'écran et tout noir
120→U:1.5*π→A:45→W
For(I,­-W,W,2		// On va de 2 en 2, plus rapide et plus lisible à l'écran
IU/W→C:√(U^2-C^2)→L
For(J,-­L,L+1
A/U*√(J^2+C^2)→T
W(sin(T)+.4*sin(3T))-I+100→Y
J+I+160→X
Line(X,Y,X,0		// Trait noir vertical jusqu'en Y
Pt-Off(X,Y		// Point blanc
End
End
Résultat sur TI-82 (après 30 minutes)
Résultat sur TI-82 (après 30 minutes)
hat.png (5.26 Kio) Vu 3083 fois
Modifié en dernier par Schraf le 22 nov. 2022 08:31, modifié 3 fois.
Avatar du membre
Schraf
Fonctionne à 1200 bauds
Fonctionne à 1200 bauds
Messages : 499
Enregistré le : 05 mars 2020 20:45
Contact :

Re: à dessiner des chapeaux

Message par Schraf »

@Gilles59 : J'ai trouvé ça dans une des revues Micro-Systèmes n°21 page 81

Image
Avatar du membre
zpalm
Fonctionne à 9600 bauds
Fonctionne à 9600 bauds
Messages : 2919
Enregistré le : 03 mai 2008 15:33
Localisation : Grenoble

Re: à dessiner des chapeaux

Message par zpalm »

Les chapeaux m’ont fait pensé à la couverture du nº1 de Micro Systèmes qui m’avait impressionné à l’époque mais c’est une fonction de Bessel, pas un chapeau …
Avatar du membre
Schraf
Fonctionne à 1200 bauds
Fonctionne à 1200 bauds
Messages : 499
Enregistré le : 05 mars 2020 20:45
Contact :

Re: à dessiner des chapeaux

Message par Schraf »

@zpalm : On n'est pas loin des chapeaux avec les fonctions de Bessel puisqu'il existe la fonction sombrero basée sur l'une d'elles.

Image
Répondre

Retourner vers « A quoi t'as joué hier ? »